FoxGlobal.Mod 65 KB

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