1 //                  ROFF for Multics
  2 //
  3 //  Last modified on 05/30/74 at 18:45:56 by R F Mabee.
  4 //
  5 //        Tree_search         Find a named symbol in the symbol table.
  6 //        GetSymbol           Return value and type of a named symbol.
  7 //        SetSymbol           Assign new value and type to a named symbol.
  8 //        SetCtable           Update any character translation table.
  9 //        StoreCtable         Evaluate translation table as string.
 10 //        UpdateSymbol        Set value and type of named symbol from control line.
 11 //        Set_ref             Process a .sr control line.
 12 //        Use_ref             Perform substitutions for named symbols.
 13 //        Check_ref           Implicit .ur for expression beginning with %.
 14 //  Only Tree_search, GetSymbol, and SetSymbol are not declared external.
 15 
 16 //  Copyright (c) 1974 by Massachusetts Institute of Technology and Honeywell Information Systems, Inc.
 17 
 18 //  General permission is granted to copy and use this program, but not to sell it, provided that the above
 19 //  copyright statement is given.  Contact Information Processing Services, MIT, for further information.
 20 //  Please contact R F Mabee at MIT for information on this program and versions for other machines.
 21 
 22 get "head"
 23 get "runoff_head"
 24 
 25 global
 26      $(   Global    : 0  $)
 27 
 28 manifest
 29      $(   NUMBER = 1
 30           STRING = 2
 31           CTABLE = 3
 32           FUNCTION = 4
 33           COUNTER = 5
 34           BUILTIN = 8
 35           SETS_PRINT = 16
 36           READ_ONLY = 32
 37           RELOCATE = 64
 38      $)
 39 
 40 
 41 let Tree_search (Name, Create) = valof
 42      $(   let x = Name!0
 43           let k = LengthInWords (Name) - 1
 44           let P, Q = 0, lv TreeRoot
 45                $(   P := rv Q
 46                     if P = 0 break
 47                     let d = P!4 - x
 48                     if d = 0 for i = 1 to k do
 49                          $(   d := P!(i + 4) - Name!i
 50                               unless d = 0 break
 51                          $)
 52                     if d = 0 resultis P
 53                     Q := d < 0 -> lv P!3, lv P!2
 54                $)   repeat
 55 
 56           unless Create resultis 0
 57 
 58           P := Newvec (k + 4)
 59           for i = 0 to k do P!(i + 4) := Name!i
 60           P!0, P!1, P!2, P!3 := 0, NUMBER, 0, 0
 61           rv Q := P
 62           resultis P
 63      $)
 64 
 65 let GetSymbol (Name, Space) be                    //  Return value of named symbol as unpacked string.
 66      $(   let P = Tree_search (Name, false)
 67           if P = 0 do                   //  Undefined name - value is null string by definition.
 68                $(   Space!0 := 0
 69                     return
 70                $)
 71 
 72           let Value, Flags = lv P!0, P!1
 73           if (Flags & BUILTIN) ne 0 do
 74                $(   Value := rv Value
 75                     if (Flags & RELOCATE) ne 0 do Value := Value + (lv Global)
 76                $)
 77           switchon Flags & 7 into                           //  Dispatch on Type.
 78                $(   case NUMBER:
 79                               StoreArabic (rv Value, Space)
 80                               return
 81 
 82                     case STRING:
 83                               Unpackstring (rv Value, Space)
 84                               return
 85 
 86                     case FUNCTION:
 87                               Value (Space, false)
 88                               return
 89 
 90                     case CTABLE:
 91                               StoreCtable (Value, Space)
 92                               return
 93 
 94                     case COUNTER:
 95                               rv Value := rv Value + 1
 96                               StoreArabic (rv Value - 1, Space)
 97                               return
 98                $)
 99      $)
100 
101 and SetSymbol (Name, Type, Value) be
102      $(   let P = Tree_search (Name, true)
103           let OldValue, Flags = lv P!0, P!1
104           if (Flags & BUILTIN) ne 0 & (Flags & READ_ONLY) = 0 do
105                $(   OldValue := rv OldValue
106                     if (Flags & RELOCATE) ne 0 do OldValue := OldValue + (lv Global)
107                     switchon Flags & 7 into                           //  Dispatch on old Type.
108                          $(   case NUMBER:
109                               case COUNTER:
110                                         unless Type = NUMBER goto UserCell
111                                         rv OldValue := Value
112                                         if (Flags & SETS_PRINT) ne 0 do Print := Fp le Np le Lp & Passes le 1
113                                         return
114 
115                               case STRING:
116                                         unless Type = STRING goto UserCell
117                                         Freevec (rv OldValue)
118                                         rv OldValue := Value
119                                         return
120 
121                               case CTABLE:
122                                         unless Type = STRING goto UserCell
123                                         SetCtable (OldValue, Value)
124                                         return
125 
126                               case FUNCTION:
127                                         unless Type = NUMBER goto UserCell
128                                         OldValue (Value, true)
129                                         return
130                          $)
131                $)
132 
133           if Flags = STRING do Freevec (P!0)
134 UserCell:
135           P!0, P!1 := Value, Type
136      $)
137 and SetCtable (Table, Value) be
138      $(   let w = vec 512
139           Unpackstring (Value, w)
140           let l = w!0
141           if l > 128 do l := 128
142           while l < 128 do
143                $(   l := l + 1
144                     w!l := '*s'
145                $)
146           for i = 0 to 127 do Table!i := w!(i + 1)
147           Freevec (Value)
148      $)
149 and StoreCtable (Table, v) be
150      $(   let j = 0
151           for i = 0 to 127 do
152                $(   j := j + 1
153                     let c = Table!i
154                     c := valof switchon c into
155                          $(   case '*b':resultis 'b'
156                               case '*n':resultis 'n'
157                               case '*t':resultis 't'
158                               case '**':resultis '**'
159                               case '"': resultis '"'
160                               default:
161                                         if $8040 le c le $8176 do
162                                              $(   v!j := c
163                                                   loop
164                                              $)
165                                         v!j := '**'
166                                         v!(j + 1) := 'c'
167                                         v!(j + 2) := c / 100 + '0'
168                                         v!(j + 3) := c / 10 rem 10 + '0'
169                                         v!(j + 4) := c rem 10 + '0'
170                                         j := j + 4
171                                         loop
172                          $)
173                     v!j := '**'
174                     v!(j + 1) := c
175                     j := j + 1
176                     loop
177                $)
178           v!0 := j
179      $)
180 
181 let UpdateSymbol (Name) be
182      $(   Check_ref ()                  //  Do substitutions if necessary.
183           let Type, Value = 0, 0
184           test Rawchar!Nrx = '"'
185           then Type, Value := STRING, GetString ()
186           or   $(   let v = vec Maxline
187                     ExpError := false
188                     Type, Value := NUMBER, ReadExp (0, v)
189                     if ExpError | Nrx < Nr do Report ("Malformed expression")
190                $)
191           SetSymbol (Name, Type, Value)
192      $)
193 
194 and Set_ref () be
195      $(   let v = vec Maxline / 4
196           if ReadName (v) = 0 return
197           UpdateSymbol (v)
198      $)
199 
200 and Use_ref (In, Out, Inl) = valof      // = Outl
201      $(   let Ini, Outi = 0, 0
202           let v = vec Maxline * 2
203           while Ini < Inl & Outi < Maxline do
204                $(   Ini := Ini + 1
205                     unless In!Ini = Spec_char do
206                          $(   Outi := Outi + 1
207                               Out!Outi := In!Ini
208                               loop
209                          $)
210                     if In!(Ini + 1) = Spec_char do          //  Double escape turns to single in output.
211                          $(   Ini := Ini + 1
212                               Outi := Outi + 1
213                               Out!Outi := Spec_char
214                               loop
215                          $)
216                     for i = Ini + 1 to Inl do
217                          $(   let c = In!i
218                               if c = Spec_char do
219                                    $(   let w = vec Maxline
220                                         for j = 1 to i - Ini - 1 do v!j := In!(Ini + j)
221                                         v!0 := i - Ini - 1
222                                         Packstring (v, w)
223                                         GetSymbol (w, v)
224                                         Ini := i
225                                         goto StoreS
226                                    $)
227                               unless 'a' le c le 'z' logor 'A' le c le 'Z' logor '0' le c le '9' logor c = '_' break
228                          $)
229                     (Roman -> StoreRoman, StoreArabic) (Np, v)
230           StoreS:   for i = 1 to v!0 do Out!(Outi + i) := v!i
231                     Outi := Outi + v!0
232                $)
233           resultis Outi
234      $)
235 
236 
237 and Check_ref () be           //  Do symbol substitution for control line if first or second character is %.
238      $(   unless Rawchar!Nrx = Spec_char logor Rawchar!(Nrx + 1) = Spec_char return
239           let w = vec Maxline
240           for i = 1 to Nr do w!i := Rawchar!i
241           let OldRoman = Roman
242           Roman := false
243           Nr := Use_ref (w + Nrx - 1, Rawchar + Nrx - 1, Nr - Nrx + 1) + Nrx - 1
244           Roman := OldRoman
245      $)
246 
247 let InitializeSymbolTree () be                    //  Set up symbol table with built-in names.
248      $(   TreeRoot := 0
249 
250           Define ("Ad", lv Ad, NUMBER | RELOCATE)
251           Define ("Ce", lv Ce, NUMBER | RELOCATE)
252           Define ("Eq", lv Eq, NUMBER | RELOCATE)
253           Define ("Fi", lv Fi, NUMBER | RELOCATE)
254           Define ("Fr", lv Fr, NUMBER | RELOCATE)
255           Define ("Ft", lv Ft, NUMBER | RELOCATE)
256           Define ("Ll", lv Ll, NUMBER | RELOCATE)
257           Define ("Ms", lv Ms, NUMBER | RELOCATE)
258           Define ("Nl", lv Nl, NUMBER | RELOCATE)
259           Define ("Pi", lv Pi, NUMBER | RELOCATE)
260           Define ("Pl", lv Pl, NUMBER | RELOCATE)
261           Define ("To", lv To, NUMBER | RELOCATE)
262           Define ("Un", lv Un, NUMBER | RELOCATE)
263           Define ("Ma1", lv Ma1, NUMBER | RELOCATE)
264           Define ("Ma2", lv Ma2, NUMBER | RELOCATE)
265           Define ("Ma3", lv Ma3, NUMBER | RELOCATE)
266           Define ("Ma4", lv Ma4, NUMBER | RELOCATE)
267           Define ("NNp", lv NNp, NUMBER | RELOCATE)
268           Define ("Foot", lv Foot, NUMBER | RELOCATE)
269           Define ("From", lv From, NUMBER | RELOCATE)
270           Define ("Print", lv Print, NUMBER | RELOCATE)
271           Define ("Start", lv Start, NUMBER | RELOCATE)
272           Define ("Roman", lv Roman, NUMBER | RELOCATE)
273           Define ("NoFtNo", lv NoFtNo, NUMBER | RELOCATE)
274           Define ("Stopsw", lv Stopsw, NUMBER | RELOCATE)
275           Define ("Waitsw", lv Waitsw, NUMBER | RELOCATE)
276           Define ("PadLeft", lv PadLeft, NUMBER | RELOCATE)
277           Define ("ExtraMargin", lv ExtraMargin, NUMBER | RELOCATE)
278           Define ("Hyphenating", lv Hyphenating, NUMBER | RELOCATE)
279           Define ("PrintLineNumbers", lv PrintLineNumbers, NUMBER | RELOCATE)
280           Define ("MultiplePagecount", lv MultiplePagecount, NUMBER | RELOCATE)
281 
282           Define ("Fp", lv Fp, NUMBER | SETS_PRINT | RELOCATE)
283           Define ("Lp", lv Lp, NUMBER | SETS_PRINT | RELOCATE)
284           Define ("Passes", lv Passes, NUMBER | SETS_PRINT | RELOCATE)
285 
286           Define ("In", lv In, NUMBER | READ_ONLY | RELOCATE)
287           Define ("Np", lv Np, NUMBER | READ_ONLY | RELOCATE)
288           Define ("Selsw", lv Selsw, NUMBER | READ_ONLY | RELOCATE)
289           Define ("Time", lv TimeNow, NUMBER | READ_ONLY | RELOCATE)
290           Define ("Filesw", lv Filesw, NUMBER | READ_ONLY | RELOCATE)
291           Define ("LinesLeft", lv LinesLeft, NUMBER | READ_ONLY | RELOCATE)
292           Define ("Printersw", lv Printersw, NUMBER | READ_ONLY | RELOCATE)
293           Define ("InputLines", lv InputLines, NUMBER | READ_ONLY | RELOCATE)
294           Define ("NestingDepth", lv NestingDepth, NUMBER | READ_ONLY | RELOCATE)
295 
296           Define ("Eqcnt", lv Eqcnt, COUNTER | RELOCATE)
297 
298           Define ("FootRef", lv FootRef, STRING | RELOCATE)
299           Define ("TextRef", lv TextRef, STRING | RELOCATE)
300           Define ("Parameter", lv Parameter, STRING | RELOCATE)
301 
302           Define ("FileName", lv FileName, STRING | READ_ONLY | RELOCATE)
303           Define ("InputFileName", lv InputFileName, STRING | READ_ONLY | RELOCATE)
304 
305           Define ("ConvTable", Conv, CTABLE)
306           Define ("TrTable", TrTable, CTABLE)
307           Define ("CharsTable", CharsTable, CTABLE)
308           Define ("DeviceTable", DeviceTable, CTABLE)
309 
310           Define ("Date", StoreDate, FUNCTION | READ_ONLY)
311           Define ("Console", ConsoleReadline, FUNCTION | READ_ONLY)
312 
313           Define ("NoPaging", NoPagingFUNCTION, FUNCTION)
314           Define ("Charsw", CharswFUNCTION, FUNCTION)
315           Define ("Device", DeviceFUNCTION, FUNCTION)
316      $)
317 and Define (Name, Value, Flag) be
318      $(   let P = Tree_search (Name, true)
319           if (Flag & RELOCATE) ne 0 do Value := Value - (lv Global)
320           P!0, P!1 := Value, Flag | BUILTIN
321      $)
322 
323 and NoPagingFUNCTION (Arg, SetSw) be
324           test SetSw
325           then SetPaging (Arg)
326           or StoreArabic (NoPaging, Arg)
327 
328 and CharswFUNCTION (Arg, SetSw) be
329           test SetSw
330           then SetCharsw (Arg)
331           or StoreArabic (Charsw, Arg)
332 
333 and DeviceFUNCTION (Arg, SetSw) be
334           test SetSw
335           then SetDevice (Arg)
336           or StoreArabic (Device, Arg)