1 //  Miscellaneous subroutines of Trans.
  2 //  Last modified on 06/06/74 at 18:26:39 by R F Mabee.
  3 //  Prepared for installation as Version 3.4 by R F Mabee.
  4 //  Modified at time of 6180 bootstrap to change interface to code generator.
  5 //  First installed as part of Version 2.7 by R F Mabee.
  6 
  7 //  Copyright (c) 1974 by Massachusetts Institute of Technology and Honeywell Information Systems, Inc.
  8 
  9 //  General permission is granted to copy and use this program, but not to sell it, provided that the above
 10 //  copyright statement is given.  Contact Information Processing Services, MIT, for further information.
 11 //  Please contact R F Mabee at MIT for information on this program and versions for other machines.
 12 
 13 get "bcpl_trans_head"
 14 
 15 let TransConditional (x, B, L) be
 16   switchon x!0 & Right into
 17      $(   case NOT_S:
 18                     TransConditional (x!1, not B, L)
 19                     return
 20 
 21           case LOGOR_S:
 22           case LOGAND_S:
 23                     test B neqv ((x!0 & Right) = LOGOR_S)
 24                     then $(   let M = Nextparam ()
 25                               TransConditional (x!1, not B, M)
 26                               TransConditional (x!2, B, L)
 27                               GenerateLabel (M)
 28                          $)
 29           or   $(   TransConditional (x!1, B, L)
 30                               TransConditional (x!2, B, L)
 31                          $)
 32                     return
 33 
 34           case COND_S:   $(   let M, N = Nextparam (), Nextparam ()
 35                               TransConditional (x!1, false, M)
 36                               TransConditional (x!2, B, L)
 37                               GenerateJump (N)
 38                               GenerateLabel (M)
 39                               TransConditional (x!3, B, L)
 40                               GenerateLabel (N)
 41                               return
 42                          $)
 43 
 44           case REL_S:
 45                     x := x!1
 46           case EQ_S: case NE_S: case LS_S: case GR_S: case LE_S: case GE_S:
 47           case EQ_F: case NE_F: case LS_F: case GR_F: case LE_F: case GE_F:
 48                          $(   let PT, M = PendingTemps, 0
 49                               let Desc1, Desc2 = vec DescSize, vec DescSize
 50                               let LeftOperand = x!1
 51                               while IsRelational (x!2) do
 52                                    $(   let MiddleOperand = x!2!1
 53                                         if CountTemporaries (MiddleOperand) > 1 do MiddleOperand := MakeCopy (MiddleOperand)
 54                                         CompileOperand (LeftOperand, Desc1)
 55                                         CompileOperand (MiddleOperand, Desc2)
 56                                         if B & M = 0 do M := Nextparam ()
 57                                         GenerateDiadicConditional (ComplementRelop (x!0 & Right), (B -> M, L), Desc1, Desc2)
 58                                         x := x!2
 59                                         LeftOperand := MiddleOperand
 60                                    $)
 61                               CompileOperand (LeftOperand, Desc1)
 62                               CompileOperand (x!2, Desc2)
 63                               let Op = x!0 & Right
 64                               unless B do Op := ComplementRelop (Op)
 65                               GenerateDiadicConditional (Op, L, Desc1, Desc2)
 66                               PutBackTemps (PT)
 67                               unless M = 0 do GenerateLabel (M)
 68                               return
 69                          $)
 70 
 71           case EQV_S:
 72                     B, x!0 := not B, NEQV_S       //  Kludge - NEQV is easier to calculate (using exclusive-OR hardware).
 73           default:  let PT, Switch = PendingTemps, vec DescSize
 74                     CompileOperand (x, Switch)
 75                     GenerateMonadicConditional ((B -> TRUE_S, FALSE_S), L, Switch)
 76                     PutBackTemps (PT)
 77      $)
 78 and ComplementRelop (Op) = valof
 79   switchon Op into
 80      $(   case EQ_S: resultis NE_S
 81           case EQ_F: resultis NE_F
 82           case NE_S: resultis EQ_S
 83           case NE_F: resultis EQ_F
 84                     case LS_S: resultis GE_S
 85           case LS_F: resultis GE_F
 86           case GE_S: resultis LS_S
 87           case GE_F: resultis LS_F
 88           case GR_S: resultis LE_S
 89           case GR_F: resultis LE_F
 90           case LE_S: resultis GR_S
 91           case LE_F: resultis GR_F
 92           default:   CGreport (UnexpectedCase, Op, "ComplementRelop")
 93                      resultis EQ_S
 94      $)
 95 
 96 let Target (x) = valof
 97      $(   let a = nil
 98           if x = 0 resultis 0
 99           switchon x!0 & Right into
100                $(   case RETURN_S:
101                               if ReturnLabel = 0 do Transreport (NotInsideRtdef, x)
102                               resultis ReturnLabel
103                     case ENDCASE_S:
104                               unless SwitchFlag do Transreport (NoSwitch, x)
105                               resultis EndcaseLabel
106                     case LOOP_S:
107                               a := lv LoopLabel
108                               goto Check
109                     case BREAK_S:
110                               a := lv BreakLabel
111                     Check:    unless LoopFlag do Transreport (NoLoop, x)
112                               if rv a = 0 do rv a := Nextparam ()
113                               resultis rv a
114                     case GOTO_S:
115                               a := x!1
116                               if (a!0 & Right) = NAME_S do
117                                    $(   let T = Cellwithname (a)
118                                         if T!1 = LABEL_S resultis T!2
119                                    $)
120                     default:  resultis 0
121                $)
122      $)
123 
124 let ListSize (List) = valof
125      $(   if List = 0 resultis 0
126           unless (List!0 & Right) = COMMA_S resultis SubListSize (List)
127           let N = 0
128           for i = 1 to List!1 do N := N + SubListSize (List!(i + 1))
129           resultis N
130      $)
131 and SubListSize (List) = valof
132      $(   unless (List!0 & Right) = REP_S resultis 1
133           unless (List!2!0 & Right) = CONSTANT_S do
134                $(   let N = Evalconst (List!2)
135                     if N < 0 do N := 0
136                     List!2 := List2 (CONSTANT_S, N)
137                $)
138           resultis List!2!1
139      $)
140 
141 and WalkList (List, F, x) be
142      $(   let N, Len = 0, ListSize (List)
143           if Len = 0 return
144           let FlatList = Newvec (Len - 1)
145           for i = 0 to Len - 1 do FlatList!i := 0
146           test (List!0 & Right) = COMMA_S
147           then for i = 1 to List!1 do N := N + WalkSubList (List!(i + 1), lv FlatList!N)
148           or WalkSubList (List, FlatList)
149           for i = 1 to Len do
150                $(   N := RandomI () rem Len repeatwhile FlatList!N = -1
151                     F (FlatList!N, x + N)
152                     FlatList!N := -1
153                          $)
154           Freevec (FlatList, Len - 1)
155      $)
156 and WalkSubList (List, Flat) = valof
157      $(   unless (List!0 & Right) = REP_S do
158                $(   Flat!0 := List
159                     resultis 1
160                $)
161           let T = List!1
162           if CountTemporaries (T) > 1 do T := MakeCopy (T)
163           let N = List!2!1
164           for i = 0 to List!2!1 - 1 do Flat!i := T
165           resultis List!2!1
166      $)
167 
168 let Assignlist (LeftTree, RightTree) be
169      $(   let Len = ListSize (RightTree)
170           and OldLHS, PT = LHSpointer, PendingTemps
171           test (LeftTree!0 & Right) = COMMA_S
172           then $(   LHSpointer := lv LeftTree!2
173                     test LeftTree!1 = Len
174                     then WalkList (RightTree, AssignElement, 0)
175                     or Transreport (Conformality, RightTree)
176                $)
177           or   $(   LHSpointer := lv LeftTree
178                     test Len = 1
179                     then WalkList (RightTree, AssignElement, 0)
180                     or Transreport (Conformality, LeftTree)
181                $)
182           LHSpointer := OldLHS
183           PutBackTemps (PT)
184      $)
185 and AssignElement (RightTree, i) be
186           CompileExpression (LHSpointer!i, RightTree)
187 
188 let TransLoop (Body, Cond, Sense, Enter) be
189      $(   let Bl, Ll, Lf = BreakLabel, LoopLabel, LoopFlag
190           BreakLabel, LoopLabel, LoopFlag := 0, Enter, true
191           unless Enter = 0 do GenerateJump (Enter)
192 
193           let Top = Nextparam ()
194           GenerateLabel (Top)
195           Transbody (Body)
196           unless LoopLabel = 0 do GenerateLabel (LoopLabel)
197           LoopFlag := false             //  Force any break in conditional to get error message.
198           test Cond = 0
199           then GenerateJump (Top)
200           or TransConditional (Cond, Sense, Top)
201           unless BreakLabel = 0 do GenerateLabel (BreakLabel)
202           BreakLabel, LoopLabel, LoopFlag := Bl, Ll, Lf
203      $)
204 
205 let TransFor (x) be
206      $(   let s, Dp, PT = SSP, DvecP, PendingTemps
207           let Bl, Ll, Lf = BreakLabel, LoopLabel, LoopFlag
208           BreakLabel, LoopLabel, LoopFlag := 0, 0, true
209 
210           let Name, Initial, Max, Step, Body = x!1, x!2, x!3, x!4, x!5
211           Addlocal (Name)
212           Checkdistinct ()
213           CompileExpression (Name, Initial)
214           unless IsConst (Max) do Max := MakeCopy (Max)
215           if Step = 0 do Step := table CONSTANT_S, 1
216 
217           let L, M = Nextparam (), Nextparam ()
218           GenerateJump (M)
219 
220           GenerateLabel (L)
221           Transbody (Body)
222           unless LoopLabel = 0 do GenerateLabel (LoopLabel)
223 
224           let T1 = list PLUS_S, Name, Step
225           CompileExpression (Name, T1)
226 
227           GenerateLabel (M)
228           let T2 = list (Evalconst (Step) < 0 -> GE_S, LE_S), Name, Max
229           TransConditional (T2, true, L)
230 
231           unless BreakLabel = 0 do GenerateLabel (BreakLabel)
232           BreakLabel, LoopLabel, LoopFlag := Bl, Ll, Lf
233           Removenames (Dp)
234           PutBackTemps (PT)
235           ResetSSP (s)
236      $)