1 //  This part of the lexical analyzer contains the miscellaneous short routines.
  2 //  Last modified on 06/06/74 at 18:25:50 by R F Mabee.
  3 //  Slight modifications installed on 6180 as Version 3.4 by R F Mabee.
  4 //  First installed as Version 2.7 on 645 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_lex_head"
 13 get "bcpl_metering_head"
 14 
 15 manifest
 16      $(   HashSize = 101  $)
 17 
 18 
 19 //  The routine Rch fetches the next input character, sets Chkind to reflect its type,
 20 //  writes the character in the listing, keeps track of line numbers for cross-reference and
 21 //  for error messages, and switches input streams when end-of-file is detected.
 22 
 23 let Rch () be
 24      $(   let UsageTemp = nil
 25           if Metering do UsageTemp := SaveOldUsage ()
 26   Top:    Readch (INPUT, Lvch)
 27           Chkind := valof switchon Ch into
 28                $(   case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': case 'G':
 29                     case 'H': case 'I': case 'J': case 'K': case 'L': case 'M': case 'N':
 30                     case 'O': case 'P': case 'Q': case 'R': case 'S': case 'T': case 'U':
 31                     case 'V': case 'W': case 'X': case 'Y': case 'Z':
 32                               resultis Capital
 33 
 34                     case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': case 'g':
 35                     case 'h': case 'i': case 'j': case 'k': case 'l': case 'm': case 'n':
 36                     case 'o': case 'p': case 'q': case 'r': case 's': case 't': case 'u':
 37                     case 'v': case 'w': case 'x': case 'y': case 'z':
 38                               resultis Small
 39 
 40                     case '0': case '1': case '2': case '3': case '4':
 41                     case '5': case '6': case '7': case '8': case '9':
 42                               resultis Digit
 43 
 44                     case '{': case '}':
 45                               resultis Bracket
 46 
 47                     case '_': resultis UnderScore
 48 
 49                     case '*s': case '*t': case '*r':
 50                     case '*v': case '*d': case '*k':
 51                     case '*f': case '*b':
 52                               resultis Ignorable
 53 
 54                     case '*n':EndCurrentLine := true
 55                               resultis Endline
 56 
 57                     case '?': unless Crep & NestingDepth = 0 resultis Simple    //  Terminator for typed-in program, otherwise illegal.
 58 
 59                     case Endofstreamch:
 60                               unless EndOfAllInputReached do TotalLines := TotalLines + (LineCount & LineMask)
 61                               if NestingDepth = 0 do                  //  If the outermost source file is finished...
 62                                    $(   Chkind := Endline
 63                                         EndOfAllInputReached := true
 64                                         goto Exit
 65                                    $)
 66                               if Listing & not BeginNewLine do Writech (OUTPUT, '*n')
 67                               NestingDepth := NestingDepth - 1                  //  For indenting listing.
 68                               PopInput ()
 69                               NLPending := true
 70                               goto Top
 71 
 72                     default:  resultis Simple
 73                $)
 74           if BeginNewLine do
 75                $(   LineCount := LineCount + 1
 76                     if Listing do
 77                          $(   for i = 1 to NestingDepth do Writech (OUTPUT, '*t')
 78                               Format (OUTPUT, "  ^4d*t", LineCount & LineMask)
 79                          $)
 80                     BeginNewLine := false
 81                $)
 82           if Listing do Writech (OUTPUT, Ch)
 83           if EndCurrentLine do BeginNewLine, EndCurrentLine := true, false
 84 
 85   Exit:   if Metering do RecordUsage (Listing -> RchWithListing_Meter, RchWithoutListing_Meter, UsageTemp)
 86      $)
 87 
 88 
 89 manifest
 90      $(   Must = $8100                  //  Categories for symbols with respect to insertion of ; and _^Hd_^Ho.
 91           May = $8000
 92           BeginCommand = $8010
 93           EndCommand = $8001
 94      $)
 95 
 96 //  Nextsymb is used throughout the syntax analyzer to get the next input canonical symbol.
 97 //  It puts the internal representation (a named constant) for the input token in the global cell Symb.
 98 //  This routine applies the pre-processor rules for inserting DO and SEMICOLON,
 99 //  as well as detecting a GET phrase.  Nsymb is used to obtain actual input symbols.
100 
101 let Nextsymb () be
102      $(   let UsageTemp = nil
103           if Metering do UsageTemp := SaveOldUsage ()
104           unless SavedSymb = 0 do
105                $(   Symb := SavedSymb
106                     SavedSymb := 0
107                     goto Exit
108                $)
109   Rnext:  Symb := Nsymb ()
110           let Category = valof switchon Symb into
111                $(   case GET_S:
112                               ProcessGet ()
113                               goto Rnext
114 
115                     case NAME_S:
116                               if Xref do EnterIntoCrossreference ()
117 
118                     case FALSE_S: case TRUE_S: case NUMBER_S:
119                     case STRINGCONST_S: case CHARCONST_S:
120                               resultis May | BeginCommand | EndCommand
121 
122                     case PLUS_S: case MINUS_S: case SECTBRA_S: case RBRA_S: case VALOF_S:
123                     case TABLE_S: case LIST_S: case SECTBEGIN_S: case NOT_S:
124                     case RV_S: case LV_S:
125                               resultis May | BeginCommand
126 
127                     case BREAK_S: case ENDCASE_S: case LOOP_S: case FINISH_S: case RETURN_S:
128                               resultis Must | BeginCommand | EndCommand
129 
130                     case MANIFEST_S: case GLOBAL_S: case STATIC_S: case EXTERNAL_S:
131                     case LET_S: case STRUCTURE_S:
132                     case CALL_S: case CASE_S: case DEFAULT_S:
133                     case FOR_S: case GOTO_S:
134                     case IF_S: case RESULTIS_S:
135                     case SWITCHON_S: case TEST_S: case UNLESS_S:
136                     case UNTIL_S: case WHILE_S:
137                               resultis Must | BeginCommand
138 
139                     case REPEAT_S:
140                               resultis Must | EndCommand
141 
142                     case NIL_S: case RKET_S: case SKET_S: case SECTKET_S: case SECTEND_S:
143                               resultis May | EndCommand
144 
145                     default:  resultis 0                    //  Can't begin or end a command.
146                $)
147           test NLPending
148           then $(   NLPending := false
149                     if (ST & EndCommand) ne 0 & (Category & BeginCommand) ne 0 do
150                          $(   SavedSymb := Symb
151                               Symb := SEMICOLON_S
152                          $)
153                $)
154           or if (ST & EndCommand) ne 0 & (Category & (Must | BeginCommand)) = (Must | BeginCommand) do
155                          $(   SavedSymb := Symb
156                               Symb := DO_S
157                          $)
158           ST := Category
159   Exit:   if Metering do RecordUsage (Nextsymb_Meter, UsageTemp)
160           if PPrep do
161                $(   WriteS (OUTPUT, SymbolName (Symb))
162                     Writech (OUTPUT, '*n')
163                $)
164      $)
165 and ProcessGet () be                    //  Handle GET phrase for Nextsymb.
166      $(   let UsageTemp = nil
167           if Metering do UsageTemp := SaveOldUsage ()
168           unless Nsymb () = STRINGCONST_S do
169                $(   CaeReport (GetStringMissing)
170                     goto Exit
171                $)
172           unless BeginNewLine do
173                $(   if Listing do Writech (OUTPUT, '*n')
174                     LineCount := LineCount - 1
175                $)
176           PushInput (DictionaryEntry!1)
177           NestingDepth := NestingDepth + 1                  //  For indenting listing.
178           BeginNewLine, NLPending := true, true
179           Ch, Chkind := '*n', Endline
180 
181   Exit:   if Metering do RecordUsage (ProcessGet_Meter, UsageTemp)
182      $)
183 
184 //  EnterIntoDictionary is called to record any string in the compiler's symbol table so that it may
185 //  be referenced by a unique pointer to a dictionary entry.  Result is left in global DictionaryEntry.
186 
187 let EnterIntoDictionary (Unpacked, Type) = valof
188      $(   let UsageTemp = nil
189           if Metering do UsageTemp := SaveOldUsage ()
190           let String = vec Vmax
191           Packstring (Unpacked, String)
192           let Len = LengthInWords (String) - 1
193           let Hash = String!0 + String!Len                  //  Use primitive hashing to fan out binary tree rapidly.
194           if Hash < 0 do Hash := - Hash
195           let Q = lv NamesTable!(Hash rem HashSize)                   //  Separate name chain for each hash value.
196                $(   DictionaryEntry := rv Q
197                     DictionaryDepth := DictionaryDepth + 1
198                     if DictionaryEntry = 0 break            //  Not found.
199                     let d = String!0 - DictionaryEntry!1!0  //  Compare raw representations.
200                     if d = 0 then for i = 1 to Len do
201                          $(   d := String!i - DictionaryEntry!1!i
202                               unless d = 0 break
203                          $)
204                     if d = 0 do                             //  Is found.
205                          $(   if Metering do RecordUsage (SymbolSearch_Meter, UsageTemp)
206                               resultis DictionaryEntry!0
207                          $)
208                     Q := d < 0 -> lv DictionaryEntry!4, lv DictionaryEntry!5
209                $)   repeat
210           DictionaryEntry := List6 (Type, StoreString (String), 0, 0, 0, 0)
211                     //  Format:  type, name pointer, value cell for Trans, xref list, < dict list, > dict list.
212           rv Q := DictionaryEntry                 //  And enter into symbol tree.
213           if Metering do RecordUsage (SymbolAdd_Meter, UsageTemp)
214           resultis Type
215      $)
216 
217 
218 //  This is LexInit, which initializes some global cells for the lexical analyzer,
219 //  and loads up the dictionary with all the reserved words with their internal values.
220 //  The lexical phase (Lex) operates as a co-routine to the syntactic phase (Cae).
221 //  Cae can keep things in its stack, but Lex must store everything in global cells.
222 
223 let LexInit () be
224      $(   Ch, Chkind, Lvch := '*n', Endline, lv Ch
225           BeginNewLine, EndCurrentLine := true, false
226           EndOfAllInputReached := false
227           NestingDepth := 0
228           NLPending, ST, SavedSymb := true, 0, 0
229           V, Vp := Newvec (Vmax), 0
230           TotalLines, DictionaryDepth := 0, 0
231           NamesTable := Newvec (HashSize)
232           for i = 0 to HashSize do NamesTable!i := 0
233 
234           LoadDictionary ()
235           Nextsymb ()                   //  Symb should always be valid.
236      $)