FoxGlobal.Mod 72 KB

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