1 //  Miscellaneous tree-building routines.
  2 //  Last modified on 06/06/74 at 18:03:09 by R F Mabee.
  3 //  Installed on 6180 as Version 3.4, R F Mabee.
  4 //  First installed on 645 as 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_cae_head"
 13 
 14 let Rblock (Rbody, Arg) = valof
 15      $(   unless Symb = SECTBRA_S do
 16                     test Symb = SECTBEGIN_S
 17                     then DictionaryEntry := 0               //  Ignore "tag" for keyword _^Hb_^He_^Hg_^Hi_^Hn.
 18                     or   $(   CaeReport (BlockExpected)
 19                               resultis Rbody (Arg)
 20                          $)
 21           let Tag = DictionaryEntry
 22           Nextsymb ()
 23           let A = Rbody (Arg)
 24           unless Symb = SECTKET_S do
 25                     test Symb = SECTEND_S
 26                     then DictionaryEntry := 0               //  As above.
 27                     or   $(   CaeReport (MissingSECTKET)
 28                               resultis A
 29                          $)
 30           if Tag = DictionaryEntry do Nextsymb ()           //  If tag on bracket is same string.
 31           resultis A
 32      $)
 33 
 34 let Rname () = valof
 35      $(   unless Symb = NAME_S do
 36                $(   CaeReport (NameExpected)
 37                     resultis ErrorNode
 38                $)
 39           let x = DictionaryEntry
 40           Nextsymb ()
 41           resultis x
 42      $)
 43 and Rnamelist (PermitREP) = GetCommaNode (Rname, 0, PermitREP)
 44 and GetCommaNode (F, x, PermitREP) = valof
 45      $(   let Op = LineCount lshift Left | COMMA_S
 46           let v, i, Max = vec 20, 0, 20
 47                $(   i := i + 1
 48                     v!i := F (x)
 49                     if Symb = REP_S & PermitREP do
 50                          $(   let Xop = LineCount lshift Left | REP_S
 51                               Nextsymb ()
 52                               v!i := List3 (Xop, v!i, Rexp (0))
 53                          $)
 54                     unless Symb = COMMA_S break
 55                     Nextsymb ()
 56                     if i ge Max do
 57                          $(   let w = Newvec (Max * 2)
 58                               for j = 1 to i do w!j := v!j
 59                               if Max > 20 do Freevec (v, Max)
 60                     v, Max := w, Max * 2
 61                          $)
 62                $)   repeat
 63           if i = 1 resultis v!1
 64           let r = Newvec (i + 1)
 65           for j = 1 to i do r!(j + 1) := v!j
 66           r!0, r!1 := Op, i
 67           if Max > 20 do Freevec (v, Max)
 68           resultis r
 69      $)
 70 and ReadList (PermitREP) = GetCommaNode (Rexp, 0, PermitREP)
 71 
 72 let Rdef () = valof
 73      $(   let A, B, C = nil, nil, nil
 74           let Lc = LineCount lshift Left
 75           A := Rnamelist (false)
 76           test Symb = RBRA_S
 77           then $(   unless (A!0 & Right) = NAME_S do CaeReport (NameExpected)
 78                     Nextsymb ()
 79                     B := 0
 80                     if Symb = NAME_S do B := Rnamelist (true)
 81                     test Symb = RKET_S
 82                     then Nextsymb ()
 83                     or CaeReport (MissingRKET)
 84                     let Ll = LabelList
 85                     LabelList := 0
 86                     let m, Op = 0, Symb
 87                     Nextsymb ()
 88                     test Op = BE_S
 89                     then $(   m := Symb
 90                               if m = MAIN_S do Nextsymb ()
 91                               C := Rcom (8)
 92                               Lc := Lc logor RTDEF_S
 93                          $)
 94                     or   $(   unless Op = VALDEF_S do CaeReport (MalformedDeclaration)
 95                               C := Rexp (0)
 96                               Lc := Lc logor FNDEF_S
 97                          $)
 98                     A := List6 (Lc, A, B, C, LabelList, m)
 99                     LabelList := Ll
100                $)
101           or   $(   unless Symb = VALDEF_S do CaeReport (MalformedDeclaration)
102                     Nextsymb ()
103                     A := List3 (VALDEF_S logor Lc, A, ReadList (true))
104                $)
105           unless Symb = AND_S resultis A
106           Lc := LineCount lshift Left
107           Nextsymb ()
108           B := Rdef ()
109           resultis List3 (AND_S logor Lc, A, B)
110      $)
111 
112 let Rdeclbody (Op) = valof
113      $(   let Match = Op = GLOBAL_S -> COLON_S, VALDEF_S
114           let A, B, C = nil, nil, 0
115                $(   A := Rname ()
116                     test Symb = Match
117                     then $(   Nextsymb ()
118                               B := Rexp (0)
119                          $)
120                     or   $(   unless Op = EXTERNAL_S do CaeReport (MalformedDeclaration)
121                               B := 0
122                          $)
123                     C := List4 (CONSTDEF_S logor LineCount lshift Left, A, B, C)
124                     unless Symb = SEMICOLON_S break
125                     Nextsymb ()
126                $)   repeat
127           resultis C
128      $)
129 
130 let CAE () = valof
131      $(   LabelList := 0
132           ErrorNode := List1 (ERROR_S)
133 
134           let A = Rcom (0)
135           unless LabelList = 0 do A := List3 (LABDEF_S, A, LabelList) //  Make dummy block for left-over labels.
136 
137           unless Symb = ENDPROG_S do
138                $(   CaeReport (PrematureTermination)
139                     Nextsymb () repeatuntil Symb = ENDPROG_S
140                $)
141           resultis A
142      $)