FoxGlobal.Mod 68 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764
  1. MODULE FoxGlobal; (** AUTHOR "fof & fn"; PURPOSE "Oberon Compiler Globally Defined Symbols"; *)
  2. (* (c) fof ETH Zürich, 2008 *)
  3. IMPORT
  4. SyntaxTree := FoxSyntaxTree, Basic := FoxBasic, Scanner := FoxScanner, Strings, Dates, D:= Debugging;
  5. CONST
  6. (* system flag names *)
  7. StringWinAPI* = "WINAPI";
  8. StringC* = "C";
  9. StringMovable*="MOVABLE";
  10. StringUntraced* = "UNTRACED";
  11. StringDelegate* = "DELEGATE";
  12. StringInterrupt*= "INTERRUPT";
  13. StringPcOffset* = "PCOFFSET";
  14. StringEntry* = "INITIAL";
  15. StringExit*= "FINAL";
  16. StringNoPAF*="NOPAF";
  17. StringFixed*="FIXED";
  18. StringFictive*="FICTIVE";
  19. StringAligned*="ALIGNED";
  20. StringAlignStack*="ALIGNSTACK";
  21. StringFinal*="FINAL";
  22. StringAbstract*="ABSTRACT";
  23. StringRegister*= "REGISTER";
  24. StringNoReturn*="NORETURN";
  25. StringUnsafe*="UNSAFE";
  26. StringPlain*="PLAIN";
  27. StringDisposable*="DISPOSABLE";
  28. StringUnchecked*="UNCHECKED";
  29. StringUncooperative*="UNCOOPERATIVE";
  30. (* block modifier flag names *)
  31. StringExclusive* = "EXCLUSIVE";
  32. StringActive* = "ACTIVE";
  33. StringPriority* = "PRIORITY";
  34. StringSafe* = "SAFE";
  35. StringRealtime* = "REALTIME";
  36. StringDynamic* = "DYNAMIC";
  37. StringFingerprint*="FingerPrint";
  38. StringInstructionWidth*="InstructionWidth";
  39. StringDataMemorySize*= "DataMemorySize";
  40. StringCodeMemorySize*= "CodeMemorySize";
  41. StringChannelWidth*= "ChannelWidth";
  42. StringChannelDepth*= "ChannelDepth";
  43. StringChannelModule*= "Channels";
  44. StringSystemModule* = "SYSTEM";
  45. StringsystemModule* = "system";
  46. StringBaseMem*= "BaseMem";
  47. StringBaseDiv*= "BaseDiv";
  48. StringVector*="Vector";
  49. StringFloatingPoint*="FloatingPoint";
  50. StringNoMul*="NoMul";
  51. StringNonBlockingIO*="HasNonBlockingIO";
  52. StringFrequencyDivider*="FrequencyDivider";
  53. StringEngine*="Engine";
  54. StringTRM*="TRM";
  55. StringTRMS*="TRMS";
  56. StringBackend*="Backend";
  57. StringRuntime*="Runtime";
  58. (* traps *)
  59. WithTrap* = 1;
  60. CaseTrap* = 2;
  61. ReturnTrap* = 3;
  62. TypeEqualTrap* = 5;
  63. TypeCheckTrap* = 6;
  64. IndexCheckTrap* = 7;
  65. AssertTrap* = 8;
  66. ArraySizeTrap* = 9;
  67. ArrayFormTrap*=10; (* fof: indicates that array cannot be (re-)allocated since shape, type or size does not match *)
  68. NoReturnTrap*=16;
  69. (** builtin procedures **)
  70. (* FoxProgTools.Enum -e -i
  71. (* global proper procedures *)
  72. Assert Copy Dec Excl Halt Inc Incl New Dispose GetProcedure Connect Delegate
  73. Read Write Reshape Wait
  74. (* global functions *)
  75. Abs Cap Chr Chr32 Entier EntierH Incr Len Long Max Min Odd Ord Ord32 Short Size
  76. Sum Dim Cas First Last Step Re Im Ash Lsh Rot
  77. (* system proper procedures *)
  78. systemGet systemPut systemMove systemNew systemRef
  79. systemTypeCode systemHalt
  80. systemPut8 systemPut16 systemPut32 systemPut64 systemTrace
  81. systemSetStackPointer systemSetFramePointer systemSetActivity
  82. (* system functions *)
  83. systemAdr systemSize systemBit systemGet64 systemGet32 systemGet16 systemGet8
  84. systemVal systemMsk
  85. systemGetStackPointer systemGetFramePointer systemGetActivity
  86. (* for active cells *)
  87. Send Receive
  88. (* for backend specific extensions *)
  89. systemSpecial
  90. (* compatibility with Oberon07 -- other mappings: LSL -> LSH, FLOOR -> Entier, Pack und Unpk currently unsupported *)
  91. Asr Ror Flt
  92. Conversion
  93. DotTimesPlus AtMulDec AtMulInc DecMul IncMul
  94. endFox
  95. ~
  96. *)
  97. (* global proper procedures *)
  98. Assert*= Scanner.EndOfText+1; Copy*= Assert+1; Dec*= Copy+1; Excl*= Dec+1; Halt*= Excl+1; Inc*= Halt+1; Incl*= Inc+1; New*= Incl+1; Dispose*= New+1; GetProcedure*= Dispose+1; Connect*= GetProcedure+1; Delegate*= Connect+1; Read*= Delegate+1; Write*= Read+1; Reshape*= Write+1; Wait*= Reshape+1;
  99. (* global functions *)
  100. Abs*= Wait+1; Cap*= Abs+1; Chr*= Cap+1; Chr32*= Chr+1; Entier*= Chr32+1; EntierH*= Entier+1; Incr*= EntierH+1; Len*= Incr+1; Long*= Len+1; Max*= Long+1; Min*= Max+1; Odd*= Min+1; Ord*= Odd+1; Ord32*= Ord+1; Short*= Ord32+1; Size*= Short+1; Sum*= Size+1; Dim*= Sum+1; Cas*= Dim+1; First*= Cas+1; Last*= First+1; Step*= Last+1; Re*= Step+1; Im*= Re+1; Ash*= Im+1; Lsh*= Ash+1; Rot*= Lsh+1;
  101. All* = Rot+1;
  102. (* system proper procedures *)
  103. systemGet*= All+1; systemPut*= systemGet+1; systemMove*= systemPut+1; systemNew*= systemMove+1; systemRef*= systemNew+1; systemTypeCode*= systemRef+1; systemHalt*= systemTypeCode+1; systemPut8*= systemHalt+1; systemPut16*= systemPut8+1; systemPut32*= systemPut16+1; systemPut64*= systemPut32+1; systemTrace*= systemPut64+1; systemSetStackPointer*= systemTrace+1; systemSetFramePointer*= systemSetStackPointer+1; systemSetActivity*= systemSetFramePointer+1;
  104. (* system functions *)
  105. systemAdr*= systemSetActivity+1; systemSize*= systemAdr+1; systemBit*= systemSize+1; systemGet64*= systemBit+1; systemGet32*= systemGet64+1; systemGet16*= systemGet32+1; systemGet8*= systemGet16+1; systemVal*= systemGet8+1; systemMsk*= systemVal+1; systemGetStackPointer*= systemMsk+1; systemGetFramePointer*= systemGetStackPointer+1; systemGetActivity*= systemGetFramePointer+1;
  106. (* for active cells *)
  107. Send*= systemGetActivity+1; Receive*= Send+1;
  108. (* for backend specific extensions *)
  109. systemSpecial*= Receive+1;
  110. (* compatibility with Oberon07 -- other mappings: LSL -> LSH, FLOOR -> Entier, Pack und Unpk currently unsupported *)
  111. Asr*= systemSpecial+1; Ror*= Asr+1; Flt*= Ror+1; Conversion*= Flt+1; DotTimesPlus*= Conversion+1; AtMulDec*= DotTimesPlus+1; AtMulInc*= AtMulDec+1; DecMul*= AtMulInc+1; IncMul*= DecMul+1; endFox*= IncMul+1;
  112. VectorCapability* = 0;
  113. FloatingPointCapability*= 1;
  114. EngineCapability*= 2;
  115. TRMSCapability*= 3;
  116. NoMulCapability*=4;
  117. NonBlockingIOCapability*=5;
  118. CONST
  119. (* LYNX extensions *)
  120. (* different naming schema to satisfy FoxScanner when parsing imports *)
  121. LynxChar* = "@lynx_char";
  122. LynxSbyte* = "@lynx_sbyte";
  123. LynxShort* = "@lynx_short";
  124. LynxInt* = "@lynx_int";
  125. LynxLong* = "@lynx_long";
  126. LynxFloat* = "@lynx_float";
  127. LynxDouble* = "@lynx_double";
  128. LynxBool* = "@lynx_bool";
  129. LynxObject* = "@lynx_object";
  130. LynxString* = "@lynx_string";
  131. LynxNewobj* = "lynx@newobj";
  132. LynxNewarr* = "lynx@newarr";
  133. LynxAsop* = "lynx@asop";
  134. LynxUnop* = "lynx@unop";
  135. LynxBinop* = "lynx@binop";
  136. LynxSend* = "lynx@send";
  137. LynxReceive* = "lynx@receive";
  138. LynxRecvnb* = "lynx@recvnb";
  139. LynxConnect* = "lynx@connect";
  140. LynxDelegate* = "lynx@delegate";
  141. LynxNewsel* = "lynx@newsel";
  142. LynxAddsel* = "lynx@addsel";
  143. LynxSelect* = "lynx@select";
  144. LynxSelidx* = "lynx@selidx";
  145. LynxOpAdd* = 1;
  146. LynxOpSub* = 2;
  147. LynxOpMul* = 3;
  148. LynxOpDiv* = 4;
  149. LynxOpRem* = 5;
  150. LynxOpAnd* = 6;
  151. LynxOpOr* = 7;
  152. LynxOpXor* = 8;
  153. LynxOpShl* = 9;
  154. LynxOpShr* = 10;
  155. LynxOpNot* = 11;
  156. SymLynxNewobj* = endFox;
  157. SymLynxNewarr* = endFox + 1;
  158. SymLynxAsop* = endFox + 2;
  159. SymLynxUnop* = endFox + 3;
  160. SymLynxBinop* = endFox + 4;
  161. SymLynxRecvnb* = endFox + 5;
  162. SymLynxNewsel* = endFox + 6;
  163. SymLynxAddsel* = endFox + 7;
  164. SymLynxSelect* = endFox + 8;
  165. SymLynxSelidx* = endFox + 9;
  166. end = endFox + 10;
  167. VAR
  168. (* names *)
  169. SelfParameterName-,ReturnParameterName-,SystemName-,systemName-,PointerReturnName-, ResultName-,
  170. A2Name-,OberonName-,ArrayBaseName-, ComplexNumbersName-, RecordBodyName-,ModuleBodyName-,
  171. NameWinAPI-,NameC-,NameMovable-,NameUntraced-,NameDelegate-,NameInterrupt-, NamePcOffset-, NameNoPAF-,NameEntry-, NameExit-, NameFixed-,NameFictive-, NameAligned-,NameStackAligned-,
  172. NameExclusive-,NameActive-,NamePriority-,NameSafe-,NameRealtime-, NameDynamic-, NameFingerprint-, NameDataMemorySize-, NameCodeMemorySize-
  173. , NameChannelWidth-, NameChannelDepth-, NameChannelModule-, NameVector-, NameFloatingPoint-, NameNoMul-,NameNonBlockingIO-, NameTRM-, NameTRMS-, NameEngine-, NameFinal-, NameAbstract-,
  174. NameBackend-, NameRuntime-, NameFrequencyDivider-, NameRegister-,NameNoReturn-,NamePlain-,NameUnsafe-,NameDisposable-,NameUnchecked-,NameUncooperative-: SyntaxTree.Identifier;
  175. identifiers: ARRAY 2 OF ARRAY end OF SyntaxTree.Identifier;
  176. (* some handy type variables for backend / checker implementers *)
  177. Boolean8-, Boolean32-: SyntaxTree.BooleanType;
  178. Integer8-, Integer16-, Integer32-, Integer64-: SyntaxTree.IntegerType;
  179. Unsigned8-, Unsigned16-, Unsigned32-, Unsigned64-: SyntaxTree.IntegerType;
  180. Character8-, Character16-, Character32-: SyntaxTree.CharacterType;
  181. Float32-, Float64-: SyntaxTree.FloatType;
  182. Complex64-, Complex128-: SyntaxTree.ComplexType;
  183. Byte8: SyntaxTree.ByteType;
  184. Byte32: SyntaxTree.ByteType;
  185. TYPE
  186. Position = SyntaxTree.Position;
  187. Alignment* = RECORD
  188. min, max: LONGINT; (* alignments in bits *)
  189. END;
  190. PassInRegisterProc = PROCEDURE {DELEGATE} (type: SyntaxTree.Type): BOOLEAN;
  191. System*= OBJECT
  192. VAR
  193. (* system and global scopes and modules (lowercase and uppercase each) *)
  194. systemScope-, globalScope-: ARRAY 2 OF SyntaxTree.ModuleScope;
  195. systemModule-,globalModule-: ARRAY 2 OF SyntaxTree.Module;
  196. activeCellsCapabilities-: SyntaxTree.Symbol; (* list of supported capabilities, filled by ActiveCells specification *)
  197. (* addressing granularity in code and data memory *)
  198. codeUnit-: LONGINT;
  199. dataUnit-: LONGINT;
  200. (* alignment (variables, record entries) *)
  201. (* alignment (parameters & stack frames) *)
  202. variableAlignment-, parameterAlignment-: Alignment;
  203. (* offset of first parameter *)
  204. offsetFirstParameter-: LONGINT;
  205. (* to determine if a builtin-procedure can be operator-overloaded *)
  206. operatorDefined-: ARRAY end OF BOOLEAN;
  207. (* type sizes defined by backend *)
  208. addressSize-: LONGINT;
  209. (* system type mapping, in a later version only the global (unisgned) types should be used
  210. the following two types are only there for compatibility with the system as is
  211. problematic are mainly the conversions between (signed) Oberon types and (unsigned) addressType.
  212. A good concept has to be derived.
  213. *)
  214. addressType-, sizeType-, shortintType-, integerType-, longintType-, hugeintType-, wordType-, longWordType-, characterType-, characterType8-, characterType16-, characterType32-, setType-, booleanType-, anyType-,byteType-,
  215. realType-, longrealType-, complexType-, longcomplexType-, objectType-, nilType-, rangeType-: SyntaxTree.Type;
  216. CanPassInRegister-: PassInRegisterProc;
  217. cellsAreObjects-: BOOLEAN;
  218. PROCEDURE &InitSystem*(codeUnit, dataUnit: LONGINT; addressSize, minVarAlign, maxVarAlign, minParAlign, maxParAlign, offsetFirstPar: LONGINT; cooperative: BOOLEAN);
  219. VAR i: LONGINT;
  220. BEGIN
  221. ASSERT(dataUnit > 0);
  222. ASSERT(minVarAlign > 0);
  223. ASSERT(maxVarAlign > 0);
  224. ASSERT(minParAlign > 0);
  225. ASSERT(maxParAlign > 0);
  226. SELF.dataUnit := dataUnit;
  227. SELF.codeUnit := codeUnit;
  228. SELF.addressSize := addressSize;
  229. SELF.variableAlignment.min := minVarAlign;
  230. SELF.variableAlignment.max := maxVarAlign;
  231. SELF.parameterAlignment.min := minParAlign;
  232. SELF.parameterAlignment.max := maxParAlign;
  233. SELF.offsetFirstParameter := offsetFirstPar;
  234. IF cooperative THEN INC(SELF.offsetFirstParameter,addressSize) END;
  235. activeCellsCapabilities := NIL;
  236. BuildScopes(SELF);
  237. FOR i := 0 TO LEN(operatorDefined)-1 DO
  238. operatorDefined[i] := FALSE;
  239. END;
  240. CanPassInRegister :=NIL;
  241. cellsAreObjects := FALSE;
  242. END InitSystem;
  243. PROCEDURE SetCellsAreObjects*(c: BOOLEAN);
  244. BEGIN
  245. cellsAreObjects := c;
  246. END SetCellsAreObjects;
  247. PROCEDURE SetRegisterPassCallback*(canPassInRegister: PassInRegisterProc);
  248. BEGIN
  249. CanPassInRegister := canPassInRegister;
  250. END SetRegisterPassCallback;
  251. PROCEDURE AddCapability*(name: SyntaxTree.Identifier);
  252. VAR symbol: SyntaxTree.Symbol;
  253. BEGIN
  254. symbol := SyntaxTree.NewSymbol(name);
  255. symbol.SetNext(activeCellsCapabilities);
  256. activeCellsCapabilities := symbol
  257. END AddCapability;
  258. PROCEDURE GenerateRecordOffsets*(x: SyntaxTree.RecordType): BOOLEAN; (* normally done in checker but the binary symbol file format makes this necessary *)
  259. VAR baseType: SyntaxTree.RecordType; offset,baseOffset, size: LONGINT; alignment, thisAlignment: LONGINT; variable: SyntaxTree.Variable;
  260. BEGIN
  261. baseType :=x.GetBaseRecord();
  262. IF (baseType # NIL) & (baseType.sizeInBits < 0) THEN
  263. IF~ GenerateRecordOffsets(baseType) THEN RETURN FALSE END;
  264. END;
  265. IF baseType # NIL THEN
  266. offset := baseType.sizeInBits;
  267. alignment := baseType.alignmentInBits;
  268. ELSE
  269. offset := 0; alignment := x.alignmentInBits;
  270. IF alignment <= 0 THEN alignment := dataUnit END;
  271. END;
  272. baseOffset := offset;
  273. variable := x.recordScope.firstVariable;
  274. WHILE (variable # NIL) DO
  275. IF ~variable.fictive THEN
  276. size := SizeOf(variable.type.resolved);
  277. IF size < 0 THEN RETURN FALSE END;
  278. IF variable.alignment > 0 THEN
  279. thisAlignment := variable.alignment*dataUnit;
  280. ELSE
  281. thisAlignment := AlignmentOf(SELF.variableAlignment, variable.type.resolved);
  282. END;
  283. Basic.Align(offset, thisAlignment);
  284. IF thisAlignment > alignment THEN alignment := thisAlignment END;
  285. variable.SetOffset(offset);
  286. INC(offset,size);
  287. ELSE
  288. variable.SetOffset(baseOffset + variable.fictiveOffset * dataUnit);
  289. END;
  290. variable := variable.nextVariable;
  291. END;
  292. x.SetAlignmentInBits(alignment);
  293. Basic.Align(offset, alignment); (* strictly speaking not necessary, but with the old object file format otherwise problems with the GC show up *)
  294. x.SetSize(offset);
  295. RETURN TRUE
  296. END GenerateRecordOffsets;
  297. PROCEDURE GenerateCellOffsets(x: SyntaxTree.CellType): BOOLEAN;
  298. VAR baseType: SyntaxTree.Type; offset,size: LONGINT; alignment, thisAlignment: LONGINT; variable: SyntaxTree.Variable;
  299. parameter: SyntaxTree.Parameter; property: SyntaxTree.Property;
  300. BEGIN
  301. baseType := x.baseType;
  302. IF (baseType # NIL) THEN
  303. baseType := baseType.resolved;
  304. IF baseType IS SyntaxTree.PointerType THEN
  305. baseType := baseType(SyntaxTree.PointerType).pointerBase.resolved
  306. END;
  307. IF (baseType IS SyntaxTree.CellType) THEN
  308. IF~ GenerateCellOffsets(baseType(SyntaxTree.CellType)) THEN RETURN FALSE END;
  309. ELSE ASSERT (baseType IS SyntaxTree.RecordType);
  310. IF~GenerateRecordOffsets(baseType(SyntaxTree.RecordType)) THEN RETURN FALSE END;
  311. END;
  312. END;
  313. IF baseType # NIL THEN
  314. offset := baseType.sizeInBits;
  315. alignment := baseType.alignmentInBits;
  316. ELSE
  317. offset := 0; alignment := x.alignmentInBits;
  318. IF alignment <= 0 THEN alignment := dataUnit END;
  319. END;
  320. IF cellsAreObjects THEN
  321. (* ports *)
  322. parameter := x.cellScope.ownerCell.firstParameter;
  323. WHILE (parameter # NIL) DO
  324. size := SizeOf(parameter.type.resolved);
  325. IF size < 0 THEN RETURN FALSE END;
  326. IF parameter.alignment > 0 THEN
  327. thisAlignment := parameter.alignment*dataUnit;
  328. ELSE
  329. thisAlignment := AlignmentOf(SELF.variableAlignment, parameter.type.resolved);
  330. END;
  331. Basic.Align(offset, thisAlignment);
  332. IF thisAlignment > alignment THEN alignment := thisAlignment END;
  333. parameter.SetOffset(offset);
  334. INC(offset,size);
  335. parameter := parameter.nextParameter;
  336. END;
  337. (* properties *)
  338. property := x.cellScope.ownerCell.firstProperty;
  339. WHILE (property # NIL) DO
  340. size := SizeOf(property.type.resolved);
  341. IF size < 0 THEN RETURN FALSE END;
  342. IF property.alignment > 0 THEN
  343. thisAlignment := property.alignment*dataUnit;
  344. ELSE
  345. thisAlignment := AlignmentOf(SELF.variableAlignment, property.type.resolved);
  346. END;
  347. Basic.Align(offset, thisAlignment);
  348. IF thisAlignment > alignment THEN alignment := thisAlignment END;
  349. property.SetOffset(offset);
  350. INC(offset,size);
  351. property := property.nextProperty;
  352. END;
  353. END;
  354. (* variables *)
  355. variable := x.cellScope.firstVariable;
  356. WHILE (variable # NIL) DO
  357. IF ~variable.fictive THEN
  358. size := SizeOf(variable.type.resolved);
  359. IF size < 0 THEN RETURN FALSE END;
  360. IF variable.alignment > 0 THEN
  361. thisAlignment := variable.alignment*dataUnit;
  362. ELSE
  363. thisAlignment := AlignmentOf(SELF.variableAlignment, variable.type.resolved);
  364. END;
  365. Basic.Align(offset, thisAlignment);
  366. IF thisAlignment > alignment THEN alignment := thisAlignment END;
  367. variable.SetOffset(offset);
  368. INC(offset,size);
  369. END;
  370. variable := variable.nextVariable;
  371. END;
  372. x.SetAlignmentInBits(alignment);
  373. Basic.Align(offset, alignment); (* strictly speaking not necessary, but with the old object file format otherwise problems with the GC show up *)
  374. x.SetSize(offset);
  375. RETURN TRUE
  376. END GenerateCellOffsets;
  377. PROCEDURE GenerateVariableOffsets*(scope: SyntaxTree.Scope): BOOLEAN;
  378. VAR variable: SyntaxTree.Variable; offset,size: LONGINT; alignment: LONGINT;
  379. BEGIN
  380. IF scope IS SyntaxTree.RecordScope THEN (* increasing indices *)
  381. RETURN GenerateRecordOffsets(scope(SyntaxTree.RecordScope).ownerRecord)
  382. ELSIF scope IS SyntaxTree.CellScope THEN
  383. RETURN GenerateCellOffsets(scope(SyntaxTree.CellScope).ownerCell);
  384. ELSE (* module scope or procedure scope: decreasing indices *)
  385. ASSERT((scope IS SyntaxTree.ModuleScope) OR (scope IS SyntaxTree.ProcedureScope));
  386. offset := 0;
  387. variable := scope.firstVariable;
  388. WHILE (variable # NIL) DO
  389. IF (variable.externalName = NIL) & ~variable.fictive THEN
  390. size := SizeOf(variable.type.resolved);
  391. IF size < 0 THEN RETURN FALSE END;
  392. DEC(offset,size);
  393. IF variable.alignment > 0 THEN
  394. Basic.Align(offset, -variable.alignment*dataUnit);
  395. ELSE
  396. alignment := AlignmentOf(SELF.variableAlignment,variable.type.resolved);
  397. Basic.Align(offset,-alignment);
  398. END;
  399. variable.SetOffset(offset);
  400. END;
  401. variable := variable.nextVariable;
  402. END;
  403. END;
  404. RETURN TRUE
  405. END GenerateVariableOffsets;
  406. PROCEDURE GenerateParameterOffsets*(procedure : SyntaxTree.Procedure; nestedProcedure: BOOLEAN): BOOLEAN;
  407. VAR offset,size: LONGINT;parameter: SyntaxTree.Parameter; procedureType: SyntaxTree.ProcedureType;
  408. BEGIN
  409. procedureType := procedure.type(SyntaxTree.ProcedureType);
  410. IF (procedure.isInline) THEN
  411. offset := 0
  412. ELSE
  413. offset := SELF.offsetFirstParameter + procedureType.parametersOffset * addressSize;
  414. END;
  415. IF nestedProcedure THEN
  416. INC(offset,addressSize); (* parameter offset of static link *) (*! check alternative: add hidden parameter *)
  417. END;
  418. IF procedureType.callingConvention = SyntaxTree.OberonCallingConvention THEN
  419. parameter := procedureType.lastParameter;
  420. WHILE (parameter # NIL) DO
  421. Basic.Align(offset,addressSize);
  422. parameter.SetOffset(offset);
  423. size := SizeOfParameter(parameter);
  424. IF size < 0 THEN RETURN FALSE END;
  425. INC(offset,size);
  426. parameter := parameter.prevParameter;
  427. END;
  428. parameter := procedureType.returnParameter;
  429. IF parameter # NIL THEN
  430. Basic.Align(offset,addressSize);
  431. parameter.SetOffset(offset);
  432. size := SizeOfParameter(parameter);
  433. IF size < 0 THEN RETURN FALSE END;
  434. INC(offset,size);
  435. END;
  436. parameter := procedureType.selfParameter;
  437. IF parameter # NIL THEN
  438. Basic.Align(offset,addressSize);
  439. parameter.SetOffset(offset);
  440. size := SizeOfParameter(parameter);
  441. IF size < 0 THEN RETURN FALSE END;
  442. INC(offset,size);
  443. END;
  444. ELSE
  445. parameter := procedureType.firstParameter;
  446. WHILE (parameter # NIL) DO
  447. Basic.Align(offset,addressSize);
  448. parameter.SetOffset(offset);
  449. size := SizeOfParameter(parameter);
  450. IF size < 0 THEN RETURN FALSE END;
  451. INC(offset,size);
  452. parameter := parameter.nextParameter;
  453. END;
  454. END;
  455. IF procedureType.isDelegate & (procedureType.selfParameter = NIL) THEN
  456. INC(offset,addressSize); (* parameter offset of delegate *)
  457. END;
  458. RETURN TRUE
  459. END GenerateParameterOffsets;
  460. PROCEDURE SizeOf*(type: SyntaxTree.Type): LONGINT;
  461. VAR size: LONGINT; base: SyntaxTree.Type;
  462. BEGIN
  463. IF type = NIL THEN RETURN -1 END;
  464. type := type.resolved;
  465. IF type IS SyntaxTree.BasicType THEN
  466. size := type.sizeInBits
  467. ELSIF type IS SyntaxTree.PointerType THEN
  468. size := addressSize
  469. ELSIF type IS SyntaxTree.ProcedureType THEN
  470. IF type(SyntaxTree.ProcedureType).isDelegate THEN
  471. size := 2*addressSize
  472. ELSE
  473. size := addressSize
  474. END;
  475. ELSIF type IS SyntaxTree.RecordType THEN
  476. (* do not treat a record type like a pointer even if the Pointer field is set, this leads to problems in object files
  477. rather make sure that each reference type is a POINTER TO at least behind the secenes!
  478. *)
  479. IF ~(SyntaxTree.Resolved IN type.state) THEN
  480. size := -1
  481. ELSE
  482. size :=type.sizeInBits;
  483. IF size < 0 THEN
  484. IF GenerateRecordOffsets(type(SyntaxTree.RecordType)) THEN
  485. size :=type.sizeInBits;
  486. ELSE
  487. size := -1
  488. END;
  489. END;
  490. END;
  491. ELSIF type IS SyntaxTree.ArrayType THEN
  492. IF ~(SyntaxTree.Resolved IN type.state) THEN
  493. size := -1
  494. ELSIF type.sizeInBits >= 0 THEN
  495. size := type.sizeInBits
  496. ELSIF type(SyntaxTree.ArrayType).form = SyntaxTree.Static THEN
  497. size := AlignedSizeOf(type(SyntaxTree.ArrayType).arrayBase.resolved)*type(SyntaxTree.ArrayType).staticLength;
  498. type.SetSize(size);
  499. ELSE
  500. size := 0; base := type;
  501. WHILE(base IS SyntaxTree.ArrayType) DO
  502. base := base(SyntaxTree.ArrayType).arrayBase.resolved;
  503. INC(size); (* length field *)
  504. END;
  505. size := size*addressSize+addressSize;
  506. type.SetSize(size)
  507. END;
  508. ELSIF type IS SyntaxTree.MathArrayType THEN
  509. IF ~(SyntaxTree.Resolved IN type.state) THEN
  510. size := -1
  511. ELSIF type(SyntaxTree.MathArrayType).form = SyntaxTree.Static THEN
  512. size := SizeOf(type(SyntaxTree.MathArrayType).arrayBase.resolved)*type(SyntaxTree.MathArrayType).staticLength
  513. ELSIF type(SyntaxTree.MathArrayType).form = SyntaxTree.Tensor THEN
  514. size := addressSize (* pointer to geometry descriptor *)
  515. ELSE
  516. size := 0;
  517. WHILE(type # NIL) & (type IS SyntaxTree.MathArrayType) DO
  518. type := type(SyntaxTree.MathArrayType).arrayBase;
  519. IF type # NIL THEN type := type.resolved END;
  520. INC(size);
  521. END;
  522. size := size*2*addressSize (* length and increments *) +5*addressSize (* data ptr, adr ptr, flags, dim and elementsize *);
  523. END;
  524. ELSIF type IS SyntaxTree.StringType THEN
  525. ASSERT(SyntaxTree.Resolved IN type.state);
  526. size := type(SyntaxTree.StringType).length * SizeOf(type(SyntaxTree.StringType).baseType);
  527. ELSIF type IS SyntaxTree.EnumerationType THEN
  528. size := addressSize
  529. ELSIF type = SyntaxTree.invalidType THEN size := 0
  530. ELSIF type IS SyntaxTree.QualifiedType THEN
  531. HALT(101); (* hint that unresolved type has been taken for type size computation *)
  532. ELSIF type IS SyntaxTree.PortType THEN
  533. size := addressSize
  534. ELSIF type IS SyntaxTree.CellType THEN
  535. size := addressSize;
  536. ELSIF type IS SyntaxTree.RangeType THEN
  537. size := 3 * SizeOf(longintType);
  538. ELSE
  539. HALT(100)
  540. END;
  541. RETURN size
  542. END SizeOf;
  543. PROCEDURE SizeOfParameter*(par: SyntaxTree.Parameter):LONGINT;
  544. BEGIN
  545. IF (par.type.resolved IS SyntaxTree.ArrayType) OR (par.type.resolved IS SyntaxTree.MathArrayType) THEN
  546. IF (par.type.resolved IS SyntaxTree.ArrayType) & (par.type.resolved(SyntaxTree.ArrayType).form = SyntaxTree.Static) &
  547. (par.kind IN {SyntaxTree.ConstParameter,SyntaxTree.VarParameter})
  548. OR
  549. (par.type.resolved IS SyntaxTree.MathArrayType) & (par.type.resolved(SyntaxTree.MathArrayType).form = SyntaxTree.Static) &
  550. (par.kind IN {SyntaxTree.ConstParameter,SyntaxTree.VarParameter})
  551. OR (par.type.resolved IS SyntaxTree.MathArrayType) & (par.kind = SyntaxTree.VarParameter)
  552. THEN
  553. RETURN addressSize
  554. ELSIF IsOberonProcedure(par.ownerType) THEN
  555. RETURN SizeOf(par.type);
  556. ELSE RETURN addressSize
  557. END
  558. ELSIF par.type.resolved IS SyntaxTree.RangeType THEN
  559. IF par.kind = SyntaxTree.VarParameter THEN
  560. RETURN addressSize
  561. ELSE
  562. RETURN SizeOf(rangeType) (* array range components are materialized on stack for both value and const parameters *)
  563. END
  564. ELSIF par.type.resolved IS SyntaxTree.RecordType THEN
  565. IF par.selfParameter THEN
  566. RETURN addressSize
  567. ELSIF (par.kind IN {SyntaxTree.ConstParameter,SyntaxTree.VarParameter}) THEN
  568. IF IsOberonProcedure(par.ownerType) THEN
  569. RETURN 2*addressSize
  570. ELSE
  571. RETURN addressSize
  572. END
  573. ELSE
  574. RETURN SizeOf(par.type);
  575. END;
  576. ELSIF par.kind = SyntaxTree.VarParameter THEN
  577. RETURN addressSize
  578. ELSIF par.kind = SyntaxTree.ConstParameter THEN
  579. RETURN SizeOf(par.type)
  580. ELSE
  581. RETURN SizeOf(par.type);
  582. END;
  583. END SizeOfParameter;
  584. PROCEDURE AlignmentOf*(CONST alignment: Alignment;type: SyntaxTree.Type): LONGINT;
  585. VAR result: LONGINT;
  586. BEGIN
  587. type := type.resolved;
  588. IF type IS SyntaxTree.RecordType THEN
  589. IF type.alignmentInBits <= 0 THEN
  590. IF GenerateRecordOffsets(type(SyntaxTree.RecordType)) THEN
  591. result := type.alignmentInBits
  592. END
  593. ELSE
  594. result := type.alignmentInBits
  595. END;
  596. ELSIF type IS SyntaxTree.ArrayType THEN
  597. IF type.alignmentInBits <= 0 THEN
  598. IF type(SyntaxTree.ArrayType).form = SyntaxTree.Static THEN
  599. result := AlignmentOf(alignment,type(SyntaxTree.ArrayType).arrayBase.resolved);
  600. ELSE
  601. result := alignment.max
  602. END;
  603. type.SetAlignmentInBits(result)
  604. ELSE
  605. result := type.alignmentInBits
  606. END;
  607. ELSIF type IS SyntaxTree.StringType THEN
  608. result := SizeOf(type(SyntaxTree.StringType).baseType);
  609. ELSE
  610. result := SizeOf(type);
  611. IF result > alignment.max THEN result := alignment.max END;
  612. IF result < alignment.min THEN result := alignment.min END;
  613. END;
  614. ASSERT(result # 0);
  615. RETURN result
  616. END AlignmentOf;
  617. PROCEDURE AlignedSizeOf*(type: SyntaxTree.Type): LONGINT;
  618. VAR size: LONGINT;
  619. BEGIN
  620. size := SizeOf(type);
  621. Basic.Align(size, AlignmentOf(variableAlignment, type));
  622. RETURN size
  623. END AlignedSizeOf;
  624. (* LYNX+ *)
  625. PROCEDURE IsLynx*(): BOOLEAN;
  626. BEGIN
  627. RETURN TRUE;
  628. END IsLynx;
  629. (* -LYNX *)
  630. END System;
  631. PROCEDURE BuildScopes(system: System);
  632. VAR i: LONGINT;
  633. BEGIN
  634. FOR i := 0 TO end-1 DO
  635. system.operatorDefined[i] := FALSE
  636. END;
  637. system.globalScope[Scanner.Uppercase] := SyntaxTree.NewModuleScope();
  638. system.globalScope[Scanner.Lowercase] := SyntaxTree.NewModuleScope();
  639. system.globalModule[Scanner.Uppercase] := SyntaxTree.NewModule("",SyntaxTree.invalidPosition,SyntaxTree.NewIdentifier("@GLOBAL"),system.globalScope[Scanner.Uppercase],Scanner.Uppercase);
  640. system.globalModule[Scanner.Lowercase] := SyntaxTree.NewModule("",SyntaxTree.invalidPosition,SyntaxTree.NewIdentifier("@global"),system.globalScope[Scanner.Lowercase],Scanner.Lowercase);
  641. system.systemScope[Scanner.Uppercase] := SyntaxTree.NewModuleScope();
  642. system.systemScope[Scanner.Lowercase] := SyntaxTree.NewModuleScope();
  643. system.systemModule[Scanner.Uppercase] := SyntaxTree.NewModule("",SyntaxTree.invalidPosition,SystemName,system.systemScope[Scanner.Uppercase],Scanner.Uppercase);
  644. system.systemModule[Scanner.Lowercase] := SyntaxTree.NewModule("",SyntaxTree.invalidPosition,systemName,system.systemScope[Scanner.Lowercase],Scanner.Lowercase);
  645. END BuildScopes;
  646. PROCEDURE SetDefaultDeclarations*(system: System; minBits: LONGINT);
  647. VAR now: Dates.DateTime; date, time: ARRAY 20 OF CHAR;
  648. BEGIN
  649. (* types *)
  650. system.longintType := SyntaxTree.NewIntegerType(32, TRUE);
  651. system.hugeintType := SyntaxTree.NewIntegerType(64, TRUE);
  652. system.wordType := SyntaxTree.NewIntegerType(MIN(system.addressSize,32),TRUE);
  653. system.longWordType := SyntaxTree.NewIntegerType(system.addressSize,TRUE);
  654. system.realType := SyntaxTree.NewFloatType(32);
  655. system.longrealType := SyntaxTree.NewFloatType(64);
  656. (*
  657. system.longintType := Integer32;
  658. system.hugeintType := Integer64;
  659. system.realType := Float32;
  660. system.longrealType := Float64;
  661. *)
  662. IF minBits = 32 THEN
  663. system.shortintType := SyntaxTree.NewIntegerType(32, TRUE);
  664. system.integerType := SyntaxTree.NewIntegerType(32, TRUE);
  665. system.booleanType := SyntaxTree.NewBooleanType(32);
  666. system.byteType := SyntaxTree.NewByteType(32);
  667. system.characterType := SyntaxTree.NewCharacterType(32);
  668. system.characterType8 := SyntaxTree.NewCharacterType(32);
  669. system.characterType16 := SyntaxTree.NewCharacterType(32);
  670. system.characterType32 := SyntaxTree.NewCharacterType(32);
  671. (*
  672. system.shortintType := Integer32;
  673. system.integerType := Integer32;
  674. system.booleanType := Boolean32;
  675. system.byteType := Byte32;
  676. system.characterType := Character32;
  677. *)
  678. ELSE
  679. ASSERT(minBits = 8); (* nothing else is currently implemented *)
  680. system.shortintType := SyntaxTree.NewIntegerType(8, TRUE);
  681. system.integerType := SyntaxTree.NewIntegerType(16, TRUE);
  682. system.booleanType := SyntaxTree.NewBooleanType(8);
  683. system.byteType := SyntaxTree.NewByteType(8);
  684. system.characterType := SyntaxTree.NewCharacterType(8);;
  685. system.characterType8 := SyntaxTree.NewCharacterType(8);;
  686. system.characterType16 := SyntaxTree.NewCharacterType(16);;
  687. system.characterType32 := SyntaxTree.NewCharacterType(32);;
  688. (*
  689. system.shortintType := Integer8;
  690. system.integerType := Integer16;
  691. system.booleanType := Boolean8;
  692. system.byteType := Byte8;
  693. system.characterType := Character8;
  694. *)
  695. END;
  696. system.anyType := SyntaxTree.NewAnyType(system.addressSize);
  697. system.objectType := SyntaxTree.NewObjectType(system.addressSize);
  698. system.nilType := SyntaxTree.NewNilType(system.addressSize);
  699. system.addressType := SyntaxTree.NewAddressType(system.addressSize);
  700. system.sizeType := SyntaxTree.NewSizeType(system.addressSize);
  701. system.rangeType := SyntaxTree.NewRangeType(3 * system.SizeOf(system.longintType));
  702. system.complexType := Complex64;
  703. system.longcomplexType := Complex128;
  704. system.setType := SyntaxTree.NewSetType(system.addressSize);
  705. (* type declarations *)
  706. DeclareType(system.byteType,"BYTE",system.systemScope);
  707. DeclareType(system.addressType,"ADDRESS",system.globalScope);
  708. DeclareType(system.sizeType,"SIZE",system.globalScope);
  709. (*DeclareType(Same,"SAME",system.systemScope);*)
  710. (* system builtin procedures *)
  711. NewBuiltin(systemGet,"GET",system.systemScope,TRUE);
  712. NewBuiltin(systemPut,"PUT",system.systemScope,TRUE);
  713. NewBuiltin(systemPut64,"PUT64",system.systemScope,TRUE);
  714. NewBuiltin(systemPut32,"PUT32",system.systemScope,TRUE);
  715. NewBuiltin(systemPut16,"PUT16",system.systemScope,TRUE);
  716. NewBuiltin(systemPut8,"PUT8",system.systemScope,TRUE);
  717. NewBuiltin(systemGet64,"GET64",system.systemScope,TRUE);
  718. NewBuiltin(systemGet32,"GET32",system.systemScope,TRUE);
  719. NewBuiltin(systemGet16,"GET16",system.systemScope,TRUE);
  720. NewBuiltin(systemGet8,"GET8",system.systemScope,TRUE);
  721. NewBuiltin(systemVal,"VAL",system.systemScope,TRUE);
  722. NewBuiltin(systemMove,"MOVE",system.systemScope,TRUE);
  723. NewBuiltin(systemRef,"REF",system.systemScope,FALSE);
  724. NewBuiltin(systemNew,"NEW",system.systemScope,FALSE);
  725. NewBuiltin(systemTypeCode,"TYPECODE",system.systemScope,TRUE);
  726. NewBuiltin(systemHalt,"HALT",system.systemScope,TRUE);
  727. NewBuiltin(systemSize,"SIZE",system.systemScope,TRUE);
  728. NewBuiltin(systemAdr,"ADR",system.systemScope,TRUE);
  729. NewBuiltin(systemMsk,"MSK",system.systemScope,TRUE);
  730. NewBuiltin(systemBit,"BIT",system.systemScope,TRUE);
  731. now := Dates.Now ();
  732. Strings.FormatDateTime ("hh:nn:ss", now, time);
  733. Strings.FormatDateTime ("mmm dd yyyy", now, date);
  734. NewStringConstantCamelCase("Time", Strings.NewString (time), system.characterType, system.systemScope);
  735. NewStringConstantCamelCase("Date", Strings.NewString (date), system.characterType, system.systemScope);
  736. NewBuiltinCamelCase(systemGetStackPointer,"GetStackPointer",system.systemScope,TRUE);
  737. NewBuiltinCamelCase(systemSetStackPointer,"SetStackPointer",system.systemScope,TRUE);
  738. NewBuiltinCamelCase(systemGetFramePointer,"GetFramePointer",system.systemScope,TRUE);
  739. NewBuiltinCamelCase(systemSetFramePointer,"SetFramePointer",system.systemScope,TRUE);
  740. NewBuiltinCamelCase(systemGetActivity,"GetActivity",system.systemScope,TRUE);
  741. NewBuiltinCamelCase(systemSetActivity,"SetActivity",system.systemScope,TRUE);
  742. (* Set up system types *)
  743. DeclareType(system.characterType,"CHAR",system.globalScope);
  744. DeclareType(system.characterType8,"CHAR8",system.globalScope);
  745. DeclareType(system.characterType16,"CHAR16",system.globalScope);
  746. DeclareType(system.characterType32,"CHAR32",system.globalScope);
  747. DeclareType(system.rangeType,"RANGE",system.globalScope);
  748. DeclareType(system.shortintType,"SHORTINT",system.globalScope);
  749. DeclareType(system.integerType,"INTEGER",system.globalScope);
  750. DeclareType(system.longintType,"LONGINT",system.globalScope);
  751. DeclareType(system.hugeintType,"HUGEINT",system.globalScope);
  752. DeclareType(system.wordType,"WORD",system.globalScope);
  753. DeclareType(system.longWordType,"LONGWORD",system.globalScope);
  754. DeclareType(Integer8, "SIGNED8", system.globalScope);
  755. DeclareType(Integer16, "SIGNED16", system.globalScope);
  756. DeclareType(Integer32, "SIGNED32", system.globalScope);
  757. DeclareType(Integer64, "SIGNED64", system.globalScope);
  758. DeclareType(Unsigned8, "UNSIGNED8", system.globalScope);
  759. DeclareType(Unsigned16, "UNSIGNED16", system.globalScope);
  760. DeclareType(Unsigned32, "UNSIGNED32", system.globalScope);
  761. DeclareType(Unsigned64, "UNSIGNED64", system.globalScope);
  762. DeclareType(system.realType,"REAL",system.globalScope);
  763. DeclareType(system.longrealType,"LONGREAL",system.globalScope);
  764. DeclareType(system.complexType,"COMPLEX",system.globalScope);
  765. DeclareType(system.longcomplexType,"LONGCOMPLEX",system.globalScope);
  766. DeclareType(system.booleanType,"BOOLEAN",system.globalScope);
  767. DeclareType(system.setType,"SET",system.globalScope);
  768. DeclareType(system.anyType,"ANY",system.globalScope);
  769. DeclareType(system.objectType,"OBJECT",system.globalScope);
  770. (* global functions *)
  771. NewBuiltin(Abs,"ABS",system.globalScope,TRUE);
  772. NewBuiltin(Ash,"ASH",system.globalScope,TRUE);
  773. NewBuiltin(Asr,"ASR",system.globalScope,TRUE);
  774. NewBuiltin(Cap,"CAP",system.globalScope,TRUE);
  775. NewBuiltin(Chr,"CHR",system.globalScope,TRUE);
  776. NewBuiltin(Chr32,"CHR32",system.globalScope,TRUE);
  777. NewBuiltin(Entier,"ENTIER",system.globalScope,TRUE);
  778. NewBuiltin(Entier,"FLOOR",system.globalScope,TRUE);
  779. NewBuiltin(EntierH,"ENTIERH",system.globalScope,TRUE);
  780. NewBuiltin(Len,"LEN",system.globalScope,TRUE);
  781. NewBuiltin(Long,"LONG",system.globalScope,TRUE);
  782. NewBuiltin(Max,"MAX",system.globalScope,TRUE);
  783. NewBuiltin(Min,"MIN",system.globalScope,TRUE);
  784. NewBuiltin(Odd,"ODD",system.globalScope,TRUE);
  785. NewBuiltin(Ord,"ORD",system.globalScope,TRUE);
  786. NewBuiltin(Ord32,"ORD32",system.globalScope,TRUE);
  787. NewBuiltin(Lsh,"LSH",system.globalScope,TRUE);
  788. NewBuiltin(Lsh,"LSL",system.globalScope,TRUE);
  789. NewBuiltin(Rot,"ROT",system.globalScope,TRUE);
  790. NewBuiltin(Ror,"ROR",system.globalScope,TRUE);
  791. NewBuiltin(Incr,"INCR",system.globalScope,TRUE);
  792. NewBuiltin(Short,"SHORT",system.globalScope,TRUE);
  793. NewBuiltin(Sum,"SUM",system.globalScope,TRUE);
  794. NewBuiltin(Dim,"DIM",system.globalScope,TRUE);
  795. NewBuiltin(Cas,"CAS",system.globalScope,TRUE);
  796. NewBuiltin(First,"FIRST",system.globalScope,TRUE);
  797. NewBuiltin(Last,"LAST",system.globalScope,TRUE);
  798. NewBuiltin(Step,"STEP",system.globalScope,TRUE);
  799. NewBuiltin(Re,"RE",system.globalScope,TRUE);
  800. NewBuiltin(Im,"IM",system.globalScope,TRUE);
  801. NewBuiltin(systemAdr,"ADDRESSOF",system.globalScope,TRUE);
  802. NewBuiltin(systemSize,"SIZEOF",system.globalScope,TRUE);
  803. (* global proper procedures *)
  804. NewBuiltin(Assert,"ASSERT",system.globalScope,TRUE);
  805. NewBuiltin(Copy,"COPY",system.globalScope,TRUE);
  806. NewBuiltin(Dec,"DEC",system.globalScope,TRUE);
  807. NewBuiltin(Excl,"EXCL",system.globalScope,TRUE);
  808. NewBuiltin(Halt,"HALT",system.globalScope,TRUE);
  809. NewBuiltin(Inc,"INC",system.globalScope,TRUE);
  810. NewBuiltin(Incl,"INCL",system.globalScope,TRUE);
  811. NewBuiltin(New,"NEW",system.globalScope,FALSE);
  812. NewBuiltin(Dispose,"DISPOSE",system.globalScope, FALSE);
  813. NewBuiltin(GetProcedure,"GETPROCEDURE",system.globalScope,TRUE);
  814. NewBuiltin(systemTrace,"TRACE",system.globalScope,TRUE);
  815. NewBuiltin(Reshape,"RESHAPE",system.globalScope,TRUE);
  816. NewBuiltin(All,"ALL",system.globalScope,TRUE);
  817. NewBuiltin(Wait,"WAIT",system.globalScope,FALSE);
  818. NewBuiltin(Connect,"CONNECT",system.globalScope,FALSE);
  819. NewBuiltin(Receive,"RECEIVE",system.globalScope,FALSE);
  820. NewBuiltin(Send,"SEND",system.globalScope,FALSE);
  821. NewBuiltin(Delegate,"DELEGATE",system.globalScope,FALSE);
  822. (*!
  823. (* Following is LYNX version: *)
  824. IF minBits = 8 THEN
  825. system.characterType := Character16;
  826. END;
  827. (* LYNX builtin types *)
  828. DeclareLynxType(system.characterType, LynxChar, system.globalScope);
  829. DeclareLynxType(system.shortintType, LynxSbyte, system.globalScope);
  830. DeclareLynxType(system.integerType, LynxShort, system.globalScope);
  831. DeclareLynxType(system.longintType, LynxInt, system.globalScope);
  832. DeclareLynxType(system.hugeintType, LynxLong, system.globalScope);
  833. DeclareLynxType(system.realType, LynxFloat, system.globalScope);
  834. DeclareLynxType(system.longrealType, LynxDouble, system.globalScope);
  835. DeclareLynxType(system.booleanType, LynxBool, system.globalScope);
  836. (* TODO: object, string *)
  837. (* LYNX global functions *)
  838. NewBuiltin(SymLynxNewobj, LynxNewobj, system.globalScope, TRUE);
  839. NewBuiltin(SymLynxNewarr, LynxNewarr, system.globalScope, TRUE);
  840. NewBuiltin(SymLynxAsop, LynxAsop, system.globalScope, TRUE);
  841. NewBuiltin(SymLynxUnop, LynxUnop, system.globalScope, TRUE);
  842. NewBuiltin(SymLynxBinop, LynxBinop, system.globalScope, TRUE);
  843. NewBuiltin(SymLynxRecvnb, LynxRecvnb, system.globalScope, TRUE);
  844. (*
  845. LynxCompiler will register builtins for send/receive/connect/delegate
  846. under "lynx@*" names but with their original Fox numeric identifiers,
  847. so that no modifications will be required in the semantic checker and
  848. intermediate backend.
  849. *)
  850. NewBuiltin(SymLynxNewsel, LynxNewsel, system.globalScope, TRUE);
  851. NewBuiltin(SymLynxAddsel, LynxAddsel, system.globalScope, TRUE);
  852. NewBuiltin(SymLynxSelect, LynxSelect, system.globalScope, TRUE);
  853. NewBuiltin(SymLynxSelidx, LynxSelidx, system.globalScope, TRUE);
  854. *)
  855. END SetDefaultDeclarations;
  856. PROCEDURE OperatorDefined*(system: System; op: LONGINT; defined: BOOLEAN);
  857. BEGIN
  858. system.operatorDefined[op] := defined;
  859. END OperatorDefined;
  860. PROCEDURE SetDefaultOperators*(system: System);
  861. VAR i: LONGINT;
  862. BEGIN
  863. FOR i := Scanner.Equal TO Scanner.Not DO
  864. OperatorDefined(system,i,TRUE);
  865. END;
  866. OperatorDefined(system, Conversion, TRUE);
  867. OperatorDefined(system, DotTimesPlus, TRUE);
  868. OperatorDefined(system, AtMulDec, TRUE);
  869. OperatorDefined(system, AtMulInc, TRUE);
  870. OperatorDefined(system, DecMul, TRUE);
  871. OperatorDefined(system, IncMul, TRUE);
  872. OperatorDefined(system,Scanner.Transpose,TRUE);
  873. OperatorDefined(system,Scanner.Becomes,TRUE);
  874. OperatorDefined(system,Dec,TRUE);
  875. OperatorDefined(system,Excl,TRUE);
  876. OperatorDefined(system,Inc,TRUE);
  877. OperatorDefined(system,Incl,TRUE);
  878. OperatorDefined(system,Abs,TRUE);
  879. OperatorDefined(system,Ash,TRUE);
  880. OperatorDefined(system,Cap,TRUE);
  881. OperatorDefined(system,Chr,TRUE);
  882. OperatorDefined(system,Entier,TRUE);
  883. OperatorDefined(system,EntierH,TRUE);
  884. OperatorDefined(system,Len,TRUE);
  885. OperatorDefined(system,Long,TRUE);
  886. OperatorDefined(system,Max,TRUE);
  887. OperatorDefined(system,Min,TRUE);
  888. OperatorDefined(system,Odd,TRUE);
  889. OperatorDefined(system,Short,TRUE);
  890. OperatorDefined(system,Sum,TRUE);
  891. OperatorDefined(system,Dim,TRUE);
  892. OperatorDefined(system,Scanner.Address, TRUE);
  893. OperatorDefined(system,Scanner.Size, TRUE);
  894. OperatorDefined(system,Scanner.Alias, TRUE);
  895. OperatorDefined(system,All,TRUE);
  896. OperatorDefined(system,Re,TRUE);
  897. OperatorDefined(system,Im,TRUE);
  898. OperatorDefined(system, Scanner.Questionmarks, TRUE);
  899. OperatorDefined(system, Scanner.GreaterGreater, TRUE);
  900. OperatorDefined(system, Scanner.LessLess, TRUE);
  901. END SetDefaultOperators;
  902. PROCEDURE DefaultSystem*(): System;
  903. VAR system: System;
  904. BEGIN
  905. NEW(system,8,8,32, 8,32,32,32,64,FALSE);
  906. SetDefaultDeclarations(system,8);
  907. SetDefaultOperators(system);
  908. RETURN system
  909. END DefaultSystem;
  910. PROCEDURE IsOberonProcedure*(type: SyntaxTree.Type): BOOLEAN;
  911. BEGIN
  912. RETURN (type IS SyntaxTree.ProcedureType) & (type(SyntaxTree.ProcedureType).callingConvention = SyntaxTree.OberonCallingConvention)
  913. END IsOberonProcedure;
  914. PROCEDURE AlignedSizeOf*(system: System; CONST alignment: Alignment; type: SyntaxTree.Type):LONGINT;
  915. VAR value: LONGINT;
  916. BEGIN
  917. value := SHORT(system.SizeOf(type));
  918. INC(value, (-value) MOD system.AlignmentOf(alignment, type));
  919. RETURN value;
  920. END AlignedSizeOf;
  921. (* returns if a module is the system module *)
  922. PROCEDURE IsSystemModule*(module: SyntaxTree.Module): BOOLEAN;
  923. BEGIN RETURN (module.name=systemName) OR (module.name=SystemName)
  924. END IsSystemModule;
  925. (** Various factories *)
  926. PROCEDURE DeclareType0(type: SyntaxTree.Type; CONST name: ARRAY OF CHAR; in: SyntaxTree.Scope);
  927. VAR basic: SyntaxTree.TypeDeclaration; duplicate: BOOLEAN;
  928. BEGIN
  929. basic := SyntaxTree.NewTypeDeclaration(SyntaxTree.invalidPosition,SyntaxTree.NewIdentifier(name));
  930. basic.SetDeclaredType(type);
  931. basic.SetState(SyntaxTree.Resolved);
  932. basic.SetAccess(SyntaxTree.ReadOnly);
  933. in.AddTypeDeclaration(basic);
  934. in.EnterSymbol(basic,duplicate);
  935. ASSERT(~duplicate);
  936. END DeclareType0;
  937. (** External interface backends can use to add their types etc. to the global scope *)
  938. PROCEDURE DeclareType*(type: SyntaxTree.Type; CONST name: ARRAY OF CHAR; CONST scope: ARRAY OF SyntaxTree.ModuleScope);
  939. VAR nameL,nameU: Scanner.IdentifierString;
  940. BEGIN
  941. Basic.Lowercase(name,nameL);
  942. Basic.Uppercase(name,nameU);
  943. DeclareType0(type,nameU,scope[Scanner.Uppercase]);
  944. DeclareType0(type,nameL,scope[Scanner.Lowercase]);
  945. END DeclareType;
  946. (* LYNX+ *)
  947. PROCEDURE DeclareLynxType*(
  948. type: SyntaxTree.Type; CONST name: ARRAY OF CHAR; CONST scope: ARRAY OF SyntaxTree.ModuleScope);
  949. BEGIN
  950. DeclareType0(type, name, scope[Scanner.Uppercase]);
  951. DeclareType0(type, name, scope[Scanner.Lowercase]);
  952. END DeclareLynxType;
  953. (* -LYNX *)
  954. PROCEDURE NewConstant0(CONST name: ARRAY OF CHAR; int: LONGINT; type: SyntaxTree.Type; in: SyntaxTree.Scope);
  955. VAR constant: SyntaxTree.Constant; value: SyntaxTree.IntegerValue;duplicate: BOOLEAN;
  956. BEGIN
  957. value := SyntaxTree.NewIntegerValue(SyntaxTree.invalidPosition,int);
  958. value.SetType(type);
  959. constant := SyntaxTree.NewConstant(SyntaxTree.invalidPosition,SyntaxTree.NewIdentifier(name));
  960. constant.SetValue(value);
  961. constant.SetType(value.type);
  962. constant.SetAccess(SyntaxTree.ReadOnly);
  963. constant.SetState(SyntaxTree.Resolved);
  964. in.AddConstant(constant);
  965. in.EnterSymbol(constant,duplicate);
  966. ASSERT(~duplicate);
  967. END NewConstant0;
  968. PROCEDURE NewConstant*(CONST name: ARRAY OF CHAR; int: LONGINT; type: SyntaxTree.Type; CONST scope: ARRAY OF SyntaxTree.ModuleScope);
  969. VAR nameL,nameU: Scanner.IdentifierString;
  970. BEGIN
  971. Basic.Lowercase(name,nameL);
  972. Basic.Uppercase(name,nameU);
  973. NewConstant0(nameU,int,type,scope[Scanner.Uppercase]);
  974. NewConstant0(nameL,int,type,scope[Scanner.Lowercase]);
  975. END NewConstant;
  976. PROCEDURE NewStringConstant0(CONST name: ARRAY OF CHAR; string: SyntaxTree.String; baseType: SyntaxTree.Type; in: SyntaxTree.Scope);
  977. VAR constant: SyntaxTree.Constant; value: SyntaxTree.StringValue;duplicate: BOOLEAN;
  978. BEGIN
  979. value := SyntaxTree.NewStringValue(SyntaxTree.invalidPosition,string);
  980. value.SetType(SyntaxTree.NewStringType(SyntaxTree.invalidPosition,baseType,value.length));
  981. constant := SyntaxTree.NewConstant(SyntaxTree.invalidPosition,SyntaxTree.NewIdentifier(name));
  982. constant.SetValue(value);
  983. constant.SetType(value.type);
  984. constant.SetAccess(SyntaxTree.ReadOnly);
  985. constant.SetState(SyntaxTree.Resolved);
  986. in.AddConstant(constant);
  987. in.EnterSymbol(constant,duplicate);
  988. ASSERT(~duplicate);
  989. END NewStringConstant0;
  990. PROCEDURE NewStringConstant*(CONST name: ARRAY OF CHAR; string: SyntaxTree.String; type: SyntaxTree.Type; CONST scope: ARRAY OF SyntaxTree.ModuleScope);
  991. VAR nameL,nameU: Scanner.IdentifierString;
  992. BEGIN
  993. Basic.Lowercase(name,nameL);
  994. Basic.Uppercase(name,nameU);
  995. NewStringConstant0(nameU,string,type,scope[Scanner.Uppercase]);
  996. NewStringConstant0(nameL,string,type,scope[Scanner.Lowercase]);
  997. END NewStringConstant;
  998. PROCEDURE NewStringConstantCamelCase*(CONST name: ARRAY OF CHAR; string: SyntaxTree.String; type: SyntaxTree.Type; CONST scope: ARRAY OF SyntaxTree.ModuleScope);
  999. BEGIN
  1000. NewStringConstant0(name,string,type,scope[Scanner.Uppercase]);
  1001. NewStringConstant0(name,string,type,scope[Scanner.Lowercase]);
  1002. END NewStringConstantCamelCase;
  1003. PROCEDURE NewBuiltin0( id: LONGINT; CONST name: ARRAY OF CHAR; in: SyntaxTree.ModuleScope; realtime: BOOLEAN);
  1004. VAR basic: SyntaxTree.Builtin; duplicate: BOOLEAN; type: SyntaxTree.ProcedureType;
  1005. BEGIN
  1006. basic := SyntaxTree.NewBuiltin(SyntaxTree.invalidPosition,SyntaxTree.NewIdentifier(name),id);
  1007. basic.SetAccess(SyntaxTree.ReadOnly);
  1008. type := SyntaxTree.NewProcedureType(SyntaxTree.invalidPosition,in);
  1009. type.SetRealtime(realtime);
  1010. type.SetReturnType(SyntaxTree.invalidType); (* make incompatible to any procedure *)
  1011. basic.SetType(type);
  1012. basic.SetState(SyntaxTree.Resolved);
  1013. in.EnterSymbol(basic,duplicate);
  1014. in.AddBuiltin(basic);
  1015. ASSERT(~duplicate);
  1016. END NewBuiltin0;
  1017. PROCEDURE NewBuiltin*(id: LONGINT; CONST name: ARRAY OF CHAR; CONST scope: ARRAY OF SyntaxTree.ModuleScope; realtime: BOOLEAN);
  1018. VAR nameL,nameU: Scanner.IdentifierString;
  1019. BEGIN
  1020. Basic.Lowercase(name,nameL);
  1021. Basic.Uppercase(name,nameU);
  1022. NewBuiltin0(id,nameU,scope[Scanner.Uppercase],realtime);
  1023. NewBuiltin0(id,nameL,scope[Scanner.Lowercase],realtime);
  1024. END NewBuiltin;
  1025. PROCEDURE NewBuiltinCamelCase*(id: LONGINT; CONST name: ARRAY OF CHAR; CONST scope: ARRAY OF SyntaxTree.ModuleScope; realtime: BOOLEAN);
  1026. BEGIN
  1027. NewBuiltin0(id,name,scope[Scanner.Uppercase],realtime);
  1028. NewBuiltin0(id,name,scope[Scanner.Lowercase],realtime);
  1029. END NewBuiltinCamelCase;
  1030. PROCEDURE NewCustomBuiltin0(CONST name: ARRAY OF CHAR; scope: SyntaxTree.ModuleScope; subType: SHORTINT; procedureType: SyntaxTree.ProcedureType);
  1031. VAR
  1032. isDuplicate: BOOLEAN;
  1033. customBuiltin: SyntaxTree.CustomBuiltin;
  1034. BEGIN
  1035. customBuiltin := SyntaxTree.NewCustomBuiltin(SyntaxTree.invalidPosition, SyntaxTree.NewIdentifier(name), systemSpecial, subType);
  1036. customBuiltin.SetAccess(SyntaxTree.ReadOnly); (* TODO: this might be changed *)
  1037. procedureType.SetRealtime(TRUE);
  1038. customBuiltin.SetType(procedureType); (* TODO: make incompatible to any procedure *)
  1039. customBuiltin.SetState(SyntaxTree.Resolved);
  1040. scope.EnterSymbol(customBuiltin, isDuplicate);
  1041. scope.AddBuiltin(customBuiltin);
  1042. ASSERT(~isDuplicate)
  1043. END NewCustomBuiltin0;
  1044. PROCEDURE NewCustomBuiltin*(CONST name: ARRAY OF CHAR; CONST scope: ARRAY OF SyntaxTree.ModuleScope; subType: SHORTINT; procedureType: SyntaxTree.ProcedureType);
  1045. VAR
  1046. nameL, nameU: Scanner.IdentifierString;
  1047. BEGIN
  1048. Basic.Lowercase(name, nameL);
  1049. Basic.Uppercase(name, nameU);
  1050. NewCustomBuiltin0(nameU, scope[Scanner.Uppercase], subType, procedureType);
  1051. NewCustomBuiltin0(nameL, scope[Scanner.Lowercase], subType, procedureType)
  1052. END NewCustomBuiltin;
  1053. PROCEDURE ModuleFileName*(moduleName,context: SyntaxTree.Identifier; VAR fileName: ARRAY OF CHAR);
  1054. VAR prefix,name: Scanner.IdentifierString;
  1055. BEGIN
  1056. Basic.GetString(moduleName,name);
  1057. IF (context = SyntaxTree.invalidIdentifier) OR (context = A2Name) THEN
  1058. COPY(name,fileName);
  1059. ELSE
  1060. ASSERT(context=OberonName);
  1061. Basic.GetString(context,prefix);
  1062. Basic.Concat(fileName,prefix,".",name);
  1063. END;
  1064. END ModuleFileName;
  1065. PROCEDURE ContextFromName*(CONST fileName: ARRAY OF CHAR; VAR module,context: SyntaxTree.Identifier);
  1066. VAR moduleName, contextName: Scanner.IdentifierString; i,j: LONGINT;
  1067. BEGIN
  1068. i := 0; j := 0;
  1069. WHILE (fileName[i] # 0X) & (fileName[i] # ".") DO
  1070. moduleName[i] := fileName[i];
  1071. INC(i);
  1072. END;
  1073. moduleName[i] := 0X;
  1074. IF fileName[i] # 0X THEN
  1075. COPY(moduleName, contextName);
  1076. INC(i);
  1077. WHILE(fileName[i] # 0X) DO
  1078. moduleName[j] := fileName[i];
  1079. INC(i); INC(j);
  1080. END;
  1081. moduleName[j] := 0X;
  1082. ELSE
  1083. contextName := "A2";
  1084. END;
  1085. module := SyntaxTree.NewIdentifier(moduleName);
  1086. context := SyntaxTree.NewIdentifier(contextName);
  1087. END ContextFromName;
  1088. PROCEDURE GetModuleName*(module: SyntaxTree.Module; VAR name: ARRAY OF CHAR);
  1089. VAR n: SyntaxTree.IdentifierString;
  1090. BEGIN
  1091. name := "";
  1092. IF module.context # SyntaxTree.invalidIdentifier THEN
  1093. Basic.GetString(module.context,n);
  1094. IF n# "A2" THEN Strings.Append(name,n);Strings.Append(name,".") END;
  1095. END;
  1096. module.GetName(n);
  1097. Strings.Append(name,n);
  1098. END GetModuleName;
  1099. PROCEDURE GetModuleSegmentedName*(module: SyntaxTree.Module; VAR name: Basic.SegmentedName);
  1100. BEGIN
  1101. Basic.InitSegmentedName(name);
  1102. IF (module.context # SyntaxTree.invalidIdentifier) & (module.context # A2Name) THEN
  1103. name[0] := module.context;
  1104. name[1] := module.name;
  1105. name[2] := -1;
  1106. ELSE
  1107. name[0] :=module.name;
  1108. name[1] := -1;
  1109. END;
  1110. END GetModuleSegmentedName;
  1111. PROCEDURE FindSymbol*(CONST name: Basic.SegmentedName; scope: SyntaxTree.Scope): SyntaxTree.Symbol;
  1112. VAR s: LONGINT; symbol : SyntaxTree.Symbol;
  1113. PROCEDURE GetSymbolScope;
  1114. VAR type: SyntaxTree.Type;
  1115. BEGIN
  1116. IF symbol IS SyntaxTree.Module THEN
  1117. scope := symbol(SyntaxTree.Module).moduleScope
  1118. ELSIF symbol IS SyntaxTree.Import THEN
  1119. scope := symbol(SyntaxTree.Import).module.moduleScope;
  1120. ELSIF symbol IS SyntaxTree.Procedure THEN
  1121. scope := symbol(SyntaxTree.Procedure).procedureScope
  1122. ELSIF symbol IS SyntaxTree.TypeDeclaration THEN
  1123. type := symbol(SyntaxTree.TypeDeclaration).declaredType.resolved;
  1124. IF type IS SyntaxTree.RecordType THEN
  1125. scope := type(SyntaxTree.RecordType).recordScope
  1126. END;
  1127. ELSE
  1128. scope := NIL
  1129. END
  1130. END GetSymbolScope;
  1131. PROCEDURE FindSymbol(name: SyntaxTree.Identifier): SyntaxTree.Symbol;
  1132. VAR symbols: SyntaxTree.Symbol;
  1133. BEGIN
  1134. IF scope = scope.ownerModule.moduleScope THEN
  1135. symbol := scope.ownerModule.moduleScope.ImportByModuleName(name, scope.ownerModule.context);
  1136. IF symbol = NIL THEN
  1137. symbol := scope.FindSymbol(name)
  1138. END;
  1139. ELSE
  1140. symbol := scope.FindSymbol(name)
  1141. END;
  1142. RETURN symbol
  1143. END FindSymbol;
  1144. BEGIN
  1145. s := 0;
  1146. IF name[0] = scope.ownerModule.name THEN
  1147. INC(s)
  1148. END;
  1149. scope := scope.ownerModule.moduleScope; (* expect fully qualified (segmented) name *)
  1150. REPEAT
  1151. IF scope = NIL THEN RETURN NIL END;
  1152. symbol := FindSymbol(name[s]);
  1153. IF symbol = NIL THEN RETURN NIL
  1154. ELSE
  1155. GetSymbolScope
  1156. END;
  1157. INC(s);
  1158. UNTIL (s = LEN(name)) OR (name[s] < 0);
  1159. RETURN symbol;
  1160. END FindSymbol;
  1161. PROCEDURE GetSymbolNameInScope*(symbol: SyntaxTree.Symbol; inScope: SyntaxTree.Scope; VAR name: ARRAY OF CHAR);
  1162. VAR n: SyntaxTree.IdentifierString; td: SyntaxTree.TypeDeclaration;
  1163. PROCEDURE Scope(scope: SyntaxTree.Scope);
  1164. BEGIN
  1165. IF scope = NIL THEN (* do nothing, locally declared temporary symbol *)
  1166. ELSIF scope = inScope THEN (* do not traverse further *)
  1167. ELSIF scope IS SyntaxTree.ModuleScope THEN
  1168. GetModuleName(scope.ownerModule, name);
  1169. Strings.Append(name,".");
  1170. ELSIF scope IS SyntaxTree.RecordScope THEN
  1171. Scope(scope.outerScope);
  1172. td := scope(SyntaxTree.RecordScope).ownerRecord.typeDeclaration;
  1173. IF td = NIL THEN
  1174. td := scope(SyntaxTree.RecordScope).ownerRecord.pointerType.typeDeclaration;
  1175. END;
  1176. td.GetName(n);
  1177. Strings.Append(name,n); Strings.Append(name,".")
  1178. ELSIF scope IS SyntaxTree.ProcedureScope THEN
  1179. Scope(scope.outerScope);
  1180. scope(SyntaxTree.ProcedureScope).ownerProcedure.GetName(n);
  1181. Strings.Append(name,n); Strings.Append(name,".")
  1182. ELSIF scope IS SyntaxTree.CellScope THEN
  1183. Scope(scope.outerScope);
  1184. td := scope(SyntaxTree.CellScope).ownerCell.typeDeclaration;
  1185. td.GetName(n);
  1186. Strings.Append(name,n); Strings.Append(name,".")
  1187. END;
  1188. END Scope;
  1189. BEGIN
  1190. name := "";
  1191. Scope(symbol.scope);
  1192. symbol.GetName(n);
  1193. IF symbol IS SyntaxTree.Operator THEN (*! append some more bits to make discrimintation possible *)
  1194. END;
  1195. Strings.Append(name,n);
  1196. END GetSymbolNameInScope;
  1197. PROCEDURE GetSymbolName*(symbol: SyntaxTree.Symbol; VAR name: ARRAY OF CHAR);
  1198. BEGIN GetSymbolNameInScope(symbol,NIL,name)
  1199. END GetSymbolName;
  1200. PROCEDURE GetSymbolSegmentedNameInScope*(symbol: SyntaxTree.Symbol; inScope: SyntaxTree.Scope; VAR pooledName: Basic.SegmentedName);
  1201. VAR n: SyntaxTree.String; td: SyntaxTree.TypeDeclaration; i: LONGINT;
  1202. PROCEDURE Scope(scope: SyntaxTree.Scope);
  1203. BEGIN
  1204. IF scope = NIL THEN (* do nothing, locally declared temporary symbol *)
  1205. ELSIF scope = inScope THEN (* do not traverse further *)
  1206. ELSIF scope IS SyntaxTree.ModuleScope THEN
  1207. IF scope(SyntaxTree.ModuleScope).ownerModule.context # A2Name THEN
  1208. Basic.SuffixSegmentedName(pooledName, scope(SyntaxTree.ModuleScope).ownerModule.context);
  1209. END;
  1210. Basic.SuffixSegmentedName(pooledName,scope.ownerModule.name);
  1211. ELSIF scope IS SyntaxTree.RecordScope THEN
  1212. Scope(scope.outerScope);
  1213. td := scope(SyntaxTree.RecordScope).ownerRecord.typeDeclaration;
  1214. IF td = NIL THEN
  1215. td := scope(SyntaxTree.RecordScope).ownerRecord.pointerType.typeDeclaration;
  1216. END;
  1217. Basic.SuffixSegmentedName(pooledName,td.name);
  1218. ELSIF scope IS SyntaxTree.ProcedureScope THEN
  1219. Scope(scope.outerScope);
  1220. Basic.SuffixSegmentedName(pooledName,scope(SyntaxTree.ProcedureScope).ownerProcedure.name);
  1221. ELSIF scope IS SyntaxTree.CellScope THEN
  1222. Scope(scope.outerScope);
  1223. td := scope(SyntaxTree.CellScope).ownerCell.typeDeclaration;
  1224. Basic.SuffixSegmentedName(pooledName, td.name);
  1225. END;
  1226. END Scope;
  1227. BEGIN
  1228. FOR i := 0 TO LEN(pooledName)-1 DO pooledName[i] := -1 END;
  1229. Scope(symbol.scope);
  1230. Basic.SuffixSegmentedName(pooledName, symbol.name);
  1231. END GetSymbolSegmentedNameInScope;
  1232. PROCEDURE GetSymbolSegmentedName*(symbol: SyntaxTree.Symbol; VAR pooledName: Basic.SegmentedName);
  1233. BEGIN
  1234. GetSymbolSegmentedNameInScope(symbol,NIL,pooledName);
  1235. END GetSymbolSegmentedName;
  1236. PROCEDURE Level*(t: SyntaxTree.Type): LONGINT;
  1237. VAR level: LONGINT;
  1238. BEGIN
  1239. IF t IS SyntaxTree.IntegerType THEN
  1240. CASE t.sizeInBits OF
  1241. 8: level := 0;
  1242. |16: level := 1;
  1243. |32: level := 2;
  1244. |64: level := 3;
  1245. END;
  1246. ELSIF t IS SyntaxTree.FloatType THEN
  1247. CASE t.sizeInBits OF
  1248. 32: level := 4;
  1249. |64: level := 5;
  1250. END
  1251. ELSE HALT(100)
  1252. END;
  1253. RETURN level
  1254. END Level;
  1255. PROCEDURE ConvertSigned*(this: HUGEINT; bits: LONGINT): HUGEINT;
  1256. BEGIN
  1257. bits := 64-bits;
  1258. RETURN ASH (ASH (this, bits), -bits);
  1259. END ConvertSigned;
  1260. PROCEDURE ConvertUnsigned*(this: HUGEINT; bits: LONGINT): HUGEINT;
  1261. BEGIN
  1262. bits := 64-bits;
  1263. RETURN LSH (LSH (this, bits), -bits);
  1264. END ConvertUnsigned;
  1265. PROCEDURE MaxInteger*(system: System; type: SyntaxTree.BasicType): HUGEINT;
  1266. BEGIN
  1267. RETURN ASH (HUGEINT(1), system.SizeOf (type) - 1) - 1;
  1268. END MaxInteger;
  1269. PROCEDURE MinInteger*(system: System; type: SyntaxTree.BasicType): HUGEINT;
  1270. BEGIN
  1271. RETURN -ASH (HUGEINT(1), system.SizeOf (type) - 1);
  1272. END MinInteger;
  1273. (*! make architecture independent ! *)
  1274. PROCEDURE MaxFloat*(system: System; type: SyntaxTree.FloatType): LONGREAL;
  1275. BEGIN
  1276. IF system.SizeOf(type) = 32 THEN RETURN MAX(REAL) ELSE RETURN MAX(LONGREAL) END;
  1277. END MaxFloat;
  1278. PROCEDURE MinFloat*(system: System; type: SyntaxTree.FloatType): LONGREAL;
  1279. BEGIN
  1280. IF system.SizeOf(type) = 32 THEN RETURN MIN(REAL) ELSE RETURN MIN(LONGREAL) END;
  1281. END MinFloat;
  1282. PROCEDURE IsUnsignedInteger*(this: HUGEINT; sizeInBits: LONGINT): BOOLEAN;
  1283. VAR m: HUGEINT;
  1284. BEGIN
  1285. m := ASH(HUGEINT(1),sizeInBits);
  1286. RETURN (this >= 0) & (this < m)
  1287. END IsUnsignedInteger;
  1288. PROCEDURE IsSignedInteger*(this: HUGEINT; sizeInBits: LONGINT): BOOLEAN;
  1289. VAR m: HUGEINT;
  1290. BEGIN
  1291. m := ASH(HUGEINT(1),sizeInBits-1);
  1292. RETURN (this < m) & (-this <= m)
  1293. END IsSignedInteger;
  1294. PROCEDURE GetSignedIntegerType*(system: System; this: HUGEINT): SyntaxTree.IntegerType;
  1295. (* code snippets for unsigned
  1296. ELSE
  1297. m := Runtime.AslH(1,system.SizeOf(type));
  1298. RETURN (this >= 0) & (this < m)
  1299. END;
  1300. PROCEDURE Bits(x: HUGEINT): BOOLEAN;
  1301. BEGIN
  1302. WHILE x > 0 DO INC(bits); x := x DIV 2 END;
  1303. END Bits;
  1304. IF a = MIN(HUGEINT) THEN (* -a does not work on lowest possible number, ~a+1 would overflow *)
  1305. RETURN Integer[64]
  1306. ELSIF a < 0 THEN
  1307. RETURN Integer[Bits(-a-1)+1]
  1308. ELSE
  1309. RETURN Unisgned[Bits(a)]
  1310. END;
  1311. *)
  1312. BEGIN
  1313. IF IsSignedInteger(this,8) THEN RETURN Integer8
  1314. ELSIF IsSignedInteger(this, 16) THEN RETURN Integer16
  1315. ELSIF IsSignedInteger(this, 32) THEN RETURN Integer32
  1316. ELSE RETURN Integer64
  1317. END;
  1318. END GetSignedIntegerType;
  1319. PROCEDURE GetIntegerType*(system: System; this: HUGEINT): SyntaxTree.IntegerType;
  1320. BEGIN
  1321. IF IsSignedInteger(this,8) THEN RETURN Integer8
  1322. (* system.SizeOf(...) = 8 : detect special backends with no sizes smaller than 32 *)
  1323. ELSIF (system.SizeOf(Unsigned8) = 8) & IsUnsignedInteger(this,8) THEN RETURN Unsigned8
  1324. ELSIF IsSignedInteger(this, 16) THEN RETURN Integer16
  1325. ELSIF (system.SizeOf(Unsigned16) = 16) & IsUnsignedInteger(this,16) THEN RETURN Unsigned16
  1326. ELSIF IsSignedInteger(this, 32) THEN RETURN Integer32
  1327. ELSIF IsUnsignedInteger(this,32) THEN RETURN Unsigned32
  1328. ELSE RETURN Integer64
  1329. END;
  1330. END GetIntegerType;
  1331. PROCEDURE NewIntegerValue*(system: System; position: Position; hugeint: HUGEINT): SyntaxTree.Value;
  1332. VAR value: SyntaxTree.IntegerValue;
  1333. BEGIN
  1334. value := SyntaxTree.NewIntegerValue(position,hugeint);
  1335. value.SetType(GetIntegerType(system,hugeint));
  1336. RETURN value
  1337. END NewIntegerValue;
  1338. PROCEDURE NewBooleanValue*(system: System; position: Position; b: BOOLEAN): SyntaxTree.Value;
  1339. VAR value: SyntaxTree.BooleanValue;
  1340. BEGIN
  1341. value := SyntaxTree.NewBooleanValue(position,b);
  1342. value.SetType(system.booleanType);
  1343. RETURN value
  1344. END NewBooleanValue;
  1345. PROCEDURE NewSetValue*(system: System; position: Position; s: SET): SyntaxTree.Value;
  1346. VAR value: SyntaxTree.SetValue;
  1347. BEGIN
  1348. value := SyntaxTree.NewSetValue(position,s);
  1349. value.SetType(system.setType);
  1350. RETURN value
  1351. END NewSetValue;
  1352. PROCEDURE NewCharacterValue*(system: System; position: Position; c: CHAR): SyntaxTree.Value;
  1353. VAR value: SyntaxTree.CharacterValue;
  1354. BEGIN
  1355. value := SyntaxTree.NewCharacterValue(position,c);
  1356. value.SetType(system.characterType);
  1357. RETURN value
  1358. END NewCharacterValue;
  1359. PROCEDURE NewNilValue*(system: System; position: Position): SyntaxTree.Value;
  1360. VAR value: SyntaxTree.NilValue;
  1361. BEGIN
  1362. value := SyntaxTree.NewNilValue(position);
  1363. value.SetType(system.anyType);
  1364. RETURN value
  1365. END NewNilValue;
  1366. (* distance for assignment to <- from *)
  1367. PROCEDURE BasicTypeDistance*(system: System; from, to: SyntaxTree.BasicType): LONGINT;
  1368. VAR fromSize, toSize, distance: LONGINT;
  1369. BEGIN
  1370. fromSize := system.SizeOf(from); toSize := system.SizeOf(to);
  1371. distance := -1;
  1372. IF (from IS SyntaxTree.IntegerType) & (to IS SyntaxTree.IntegerType) & (toSize >= fromSize) THEN
  1373. IF from(SyntaxTree.IntegerType).signed # to(SyntaxTree.IntegerType).signed THEN
  1374. IF (toSize=fromSize) & to(SyntaxTree.IntegerType).signed THEN
  1375. distance := MIN(LONGINT)
  1376. ELSE
  1377. INC(distance,2);
  1378. END;
  1379. END;
  1380. WHILE toSize >= fromSize DO
  1381. toSize := toSize DIV 2; INC(distance);
  1382. END;
  1383. ELSIF (from IS SyntaxTree.IntegerType) & (to IS SyntaxTree.SizeType) & (toSize >= fromSize) THEN
  1384. distance := 1;
  1385. WHILE toSize >= fromSize DO
  1386. toSize := toSize DIV 2; INC(distance);
  1387. END;
  1388. ELSIF (from IS SyntaxTree.SizeType) & (to IS SyntaxTree.IntegerType) & (toSize >= fromSize) THEN
  1389. distance := 1;
  1390. WHILE toSize >= fromSize DO
  1391. toSize := toSize DIV 2; INC(distance);
  1392. END;
  1393. ELSIF (from IS SyntaxTree.CharacterType) & (to IS SyntaxTree.CharacterType) & (toSize >= fromSize) OR
  1394. (from IS SyntaxTree.FloatType) & (to IS SyntaxTree.FloatType) & (toSize >= fromSize)
  1395. THEN
  1396. WHILE toSize >= fromSize DO
  1397. toSize := toSize DIV 2; INC(distance);
  1398. END;
  1399. ELSIF (from IS SyntaxTree.IntegerType) & (to IS SyntaxTree.FloatType) THEN
  1400. IF toSize = 64 THEN distance := 1 ELSE distance := 0 END;
  1401. toSize := 64;
  1402. WHILE toSize >= fromSize DO
  1403. toSize := toSize DIV 2; INC(distance);
  1404. END;
  1405. ELSIF (from IS SyntaxTree.RangeType) & (to IS SyntaxTree.RangeType) THEN
  1406. distance := 0;
  1407. ELSIF (from IS SyntaxTree.BooleanType) & (to IS SyntaxTree.BooleanType) THEN
  1408. distance := 0;
  1409. END;
  1410. IF distance < 0 THEN distance := MAX(LONGINT) END;
  1411. RETURN distance
  1412. END BasicTypeDistance;
  1413. PROCEDURE GetIdentifier*(symbol: LONGINT; case: LONGINT): SyntaxTree.Identifier;
  1414. BEGIN
  1415. IF (symbol >= 0) & (symbol < LEN(identifiers,1)) THEN
  1416. RETURN identifiers[case,symbol]
  1417. ELSE
  1418. RETURN SyntaxTree.invalidIdentifier
  1419. END;
  1420. END GetIdentifier;
  1421. PROCEDURE GetSymbol*(case: LONGINT; id: SyntaxTree.Identifier): LONGINT;
  1422. VAR i: LONGINT;
  1423. BEGIN
  1424. (*! quick and dirty implementation, optimize ! *)
  1425. FOR i := 0 TO LEN(identifiers,1)-1 DO
  1426. IF id=identifiers[case,i] THEN RETURN i END;
  1427. END;
  1428. RETURN -1
  1429. END GetSymbol;
  1430. PROCEDURE InitIdentifiers;
  1431. VAR i: LONGINT;
  1432. PROCEDURE NewKeywordIdentifier(op: LONGINT);
  1433. VAR id: Scanner.IdentifierType;
  1434. BEGIN
  1435. Scanner.GetKeyword(Scanner.Uppercase,op,id);
  1436. identifiers[Scanner.Uppercase,op] := id;
  1437. Scanner.GetKeyword(Scanner.Lowercase,op,id);
  1438. identifiers[Scanner.Lowercase,op] := id;
  1439. END NewKeywordIdentifier;
  1440. PROCEDURE NewBuiltinIdentifier(op: LONGINT; CONST name: ARRAY OF CHAR);
  1441. VAR nameL,nameU: Scanner.IdentifierString;
  1442. BEGIN
  1443. ASSERT(op < LEN(identifiers[0]));
  1444. Basic.Lowercase(name,nameL);
  1445. Basic.Uppercase(name,nameU);
  1446. identifiers[Scanner.Lowercase,op] := SyntaxTree.NewIdentifier(nameL);
  1447. identifiers[Scanner.Uppercase,op] := SyntaxTree.NewIdentifier(nameU);
  1448. END NewBuiltinIdentifier;
  1449. BEGIN
  1450. FOR i := 0 TO LEN(identifiers,1)-1 DO
  1451. identifiers[Scanner.Uppercase,i] := SyntaxTree.invalidIdentifier; identifiers[Scanner.Lowercase,i] := SyntaxTree.invalidIdentifier;
  1452. END;
  1453. FOR i := 0 TO Scanner.EndOfText-1 DO
  1454. NewKeywordIdentifier(i);
  1455. END;
  1456. NewBuiltinIdentifier(Abs,"ABS");
  1457. NewBuiltinIdentifier(Ash,"ASH");
  1458. NewBuiltinIdentifier(Asr,"ASR");
  1459. NewBuiltinIdentifier(Cap,"CAP");
  1460. NewBuiltinIdentifier(Chr,"CHR");
  1461. NewBuiltinIdentifier(Chr32,"CHR32");
  1462. NewBuiltinIdentifier(Entier,"ENTIER");
  1463. NewBuiltinIdentifier(EntierH,"ENTIERH");
  1464. NewBuiltinIdentifier(Len,"LEN");
  1465. NewBuiltinIdentifier(Long,"LONG");
  1466. NewBuiltinIdentifier(Lsh,"LSH");
  1467. NewBuiltinIdentifier(Max,"MAX");
  1468. NewBuiltinIdentifier(Min,"MIN");
  1469. NewBuiltinIdentifier(Odd,"ODD");
  1470. NewBuiltinIdentifier(Ord,"ORD");
  1471. NewBuiltinIdentifier(Ord32,"ORD32");
  1472. NewBuiltinIdentifier(Ror,"ROR");
  1473. NewBuiltinIdentifier(Rot,"ROT");
  1474. NewBuiltinIdentifier(Short,"SHORT");
  1475. NewBuiltinIdentifier(Sum,"SUM");
  1476. NewBuiltinIdentifier(Dim,"DIM");
  1477. NewBuiltinIdentifier(Cas,"CAS");
  1478. NewBuiltinIdentifier(Dec,"DEC");
  1479. NewBuiltinIdentifier(Excl,"EXCL");
  1480. NewBuiltinIdentifier(Inc,"INC");
  1481. NewBuiltinIdentifier(Incl,"INCL");
  1482. NewBuiltinIdentifier(All,"ALL");
  1483. NewBuiltinIdentifier(Re,"RE");
  1484. NewBuiltinIdentifier(Im,"IM");
  1485. (* TODO: check if ok. The operators defined in FoxArrayBase require the following identifiers *)
  1486. (* TODO: ".*+" should preferably be added as a new token in the scanner *)
  1487. identifiers[Scanner.Lowercase, Scanner.Becomes] := SyntaxTree.NewIdentifier(":=");
  1488. identifiers[Scanner.Uppercase, Scanner.Becomes] := SyntaxTree.NewIdentifier(":=");
  1489. identifiers[Scanner.Lowercase, Scanner.Transpose] := SyntaxTree.NewIdentifier("`");
  1490. identifiers[Scanner.Uppercase, Scanner.Transpose] := SyntaxTree.NewIdentifier("`");
  1491. identifiers[Scanner.Lowercase, DotTimesPlus] := SyntaxTree.NewIdentifier(".*+");
  1492. identifiers[Scanner.Uppercase, DotTimesPlus] := SyntaxTree.NewIdentifier(".*+");
  1493. identifiers[Scanner.Lowercase, AtMulDec] := SyntaxTree.NewIdentifier("@MulDec");
  1494. identifiers[Scanner.Uppercase, AtMulDec] := SyntaxTree.NewIdentifier("@MulDec");
  1495. identifiers[Scanner.Lowercase, AtMulInc] := SyntaxTree.NewIdentifier("@MulInc");
  1496. identifiers[Scanner.Uppercase, AtMulInc] := SyntaxTree.NewIdentifier("@MulInc");
  1497. identifiers[Scanner.Lowercase, DecMul] := SyntaxTree.NewIdentifier("DecMul");
  1498. identifiers[Scanner.Uppercase, DecMul] := SyntaxTree.NewIdentifier("DecMul");
  1499. identifiers[Scanner.Lowercase, IncMul] := SyntaxTree.NewIdentifier("IncMul");
  1500. identifiers[Scanner.Uppercase, IncMul] := SyntaxTree.NewIdentifier("IncMul");
  1501. identifiers[Scanner.Lowercase,Conversion] := SyntaxTree.NewIdentifier("@Convert");
  1502. identifiers[Scanner.Uppercase,Conversion] := SyntaxTree.NewIdentifier("@Convert");
  1503. END InitIdentifiers;
  1504. (** initialize the global namespace *)
  1505. PROCEDURE Init;
  1506. BEGIN
  1507. InitIdentifiers;
  1508. (* names are not arbitrary, do not change unless you know what you do (compatibilty with paco!) *)
  1509. SystemName := SyntaxTree.NewIdentifier("SYSTEM");
  1510. systemName := SyntaxTree.NewIdentifier("system");
  1511. SelfParameterName := SyntaxTree.NewIdentifier("@Self");
  1512. ReturnParameterName := SyntaxTree.NewIdentifier("@ReturnParameter");
  1513. PointerReturnName := SyntaxTree.NewIdentifier("@PtrReturnType");
  1514. ResultName := SyntaxTree.NewIdentifier("RESULT");
  1515. A2Name := SyntaxTree.NewIdentifier("A2");
  1516. OberonName := SyntaxTree.NewIdentifier("Oberon");
  1517. ArrayBaseName := SyntaxTree.NewIdentifier("FoxArrayBase");
  1518. ComplexNumbersName := SyntaxTree.NewIdentifier("ComplexNumbers");
  1519. RecordBodyName := SyntaxTree.NewIdentifier("@Body");
  1520. ModuleBodyName := SyntaxTree.NewIdentifier("@Body");
  1521. NameWinAPI := SyntaxTree.NewIdentifier(StringWinAPI);
  1522. NameC := SyntaxTree.NewIdentifier(StringC);
  1523. NameMovable := SyntaxTree.NewIdentifier(StringMovable);
  1524. NameUntraced := SyntaxTree.NewIdentifier(StringUntraced);
  1525. NameDelegate := SyntaxTree.NewIdentifier(StringDelegate);
  1526. NameInterrupt := SyntaxTree.NewIdentifier(StringInterrupt);
  1527. NamePcOffset := SyntaxTree.NewIdentifier(StringPcOffset);
  1528. NameNoPAF := SyntaxTree.NewIdentifier(StringNoPAF);
  1529. NameEntry := SyntaxTree.NewIdentifier(StringEntry);
  1530. NameExit := SyntaxTree.NewIdentifier(StringExit);
  1531. NameFixed := SyntaxTree.NewIdentifier(StringFixed);
  1532. NameFictive := SyntaxTree.NewIdentifier(StringFictive);
  1533. NameAligned := SyntaxTree.NewIdentifier(StringAligned);
  1534. NameStackAligned := SyntaxTree.NewIdentifier(StringAlignStack);
  1535. NameExclusive := SyntaxTree.NewIdentifier(StringExclusive);
  1536. NameActive := SyntaxTree.NewIdentifier(StringActive);
  1537. NamePriority := SyntaxTree.NewIdentifier(StringPriority);
  1538. NameSafe := SyntaxTree.NewIdentifier(StringSafe);
  1539. NameRealtime := SyntaxTree.NewIdentifier(StringRealtime);
  1540. NameDynamic := SyntaxTree.NewIdentifier(StringDynamic);
  1541. NameDataMemorySize := SyntaxTree.NewIdentifier(StringDataMemorySize);
  1542. NameCodeMemorySize := SyntaxTree.NewIdentifier(StringCodeMemorySize);
  1543. NameChannelWidth := SyntaxTree.NewIdentifier(StringChannelWidth);
  1544. NameChannelDepth := SyntaxTree.NewIdentifier(StringChannelDepth);
  1545. NameChannelModule := SyntaxTree.NewIdentifier(StringChannelModule);
  1546. NameVector := SyntaxTree.NewIdentifier(StringVector);
  1547. NameFloatingPoint := SyntaxTree.NewIdentifier(StringFloatingPoint);
  1548. NameNoMul:= SyntaxTree.NewIdentifier(StringNoMul);
  1549. NameNonBlockingIO:=SyntaxTree.NewIdentifier(StringNonBlockingIO);
  1550. NameTRM := SyntaxTree.NewIdentifier(StringTRM);
  1551. NameTRMS := SyntaxTree.NewIdentifier(StringTRMS);
  1552. NameBackend := SyntaxTree.NewIdentifier(StringBackend);
  1553. NameRuntime := SyntaxTree.NewIdentifier(StringRuntime);
  1554. NameEngine := SyntaxTree.NewIdentifier(StringEngine);
  1555. NameFinal := SyntaxTree.NewIdentifier(StringFinal);
  1556. NameAbstract := SyntaxTree.NewIdentifier(StringAbstract);
  1557. NameFrequencyDivider := SyntaxTree.NewIdentifier(StringFrequencyDivider);
  1558. NameRegister := SyntaxTree.NewIdentifier(StringRegister);
  1559. NameNoReturn := SyntaxTree.NewIdentifier(StringNoReturn);
  1560. NamePlain := SyntaxTree.NewIdentifier(StringPlain);
  1561. NameUnsafe := SyntaxTree.NewIdentifier(StringUnsafe);
  1562. NameDisposable := SyntaxTree.NewIdentifier(StringDisposable);
  1563. NameUnchecked := SyntaxTree.NewIdentifier(StringUnchecked);
  1564. NameUncooperative := SyntaxTree.NewIdentifier(StringUncooperative);
  1565. NameFingerprint := SyntaxTree.NewIdentifier(StringFingerprint);
  1566. (* types *)
  1567. Boolean8 := SyntaxTree.NewBooleanType(8);
  1568. Boolean32 := SyntaxTree.NewBooleanType(32);
  1569. Integer8 := SyntaxTree.NewIntegerType(8, TRUE);
  1570. Integer16 := SyntaxTree.NewIntegerType(16, TRUE);
  1571. Integer32 := SyntaxTree.NewIntegerType(32, TRUE);
  1572. Integer64 := SyntaxTree.NewIntegerType(64, TRUE);
  1573. Unsigned8 := SyntaxTree.NewIntegerType(8, FALSE);
  1574. Unsigned16 := SyntaxTree.NewIntegerType(16, FALSE);
  1575. Unsigned32 := SyntaxTree.NewIntegerType(32, FALSE);
  1576. Unsigned64 := SyntaxTree.NewIntegerType(64, FALSE);
  1577. Float32 := SyntaxTree.NewFloatType(32);
  1578. Float64 := SyntaxTree.NewFloatType(64);
  1579. Complex64 := SyntaxTree.NewComplexType(Float32);
  1580. Complex128 := SyntaxTree.NewComplexType(Float64);
  1581. Byte8 := SyntaxTree.NewByteType(8);
  1582. Byte32 := SyntaxTree.NewByteType(32);
  1583. Character8 := SyntaxTree.NewCharacterType(8);
  1584. Character16 := SyntaxTree.NewCharacterType(16);
  1585. Character32 := SyntaxTree.NewCharacterType(32);
  1586. END Init;
  1587. BEGIN
  1588. Init;
  1589. END FoxGlobal.