FoxGlobal.Mod 64 KB

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