FoxBinarySymbolFile.Mod 88 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486
  1. MODULE FoxBinarySymbolFile; (** AUTHOR "fof"; PURPOSE "Symbol File - Binary Format"; *)
  2. IMPORT
  3. Basic := FoxBasic, Scanner := FoxScanner, SyntaxTree := FoxSyntaxTree, Global := FoxGlobal,
  4. Files,Streams, Kernel, SYSTEM, D := Debugging, Diagnostics, Options, Formats := FoxFormats, InterfaceComparison := FoxInterfaceComparison
  5. ,Commands, Printout := FoxPrintout, SemanticChecker := FoxSemanticChecker,
  6. Machine
  7. ;
  8. (** Symbol File Format
  9. SymbolFile = codeOptions:RawSet
  10. Imports
  11. [sfSysFlag sysFlags:RawNum]
  12. [sfConst {Symbol Value}]
  13. [sfVar {Symbol}]
  14. [sfXProcedure {Symbol ParameterList}]
  15. [sfOperator {Symbol ParameterList [sfInline Inline]}]
  16. [sfCProcedure {Symbol ParameterList Inline}]
  17. [sfAlias {Type name:RawString}]
  18. [sfType {Type}]
  19. sfEnd.
  20. Imports = {moduleName:RawString} 0X
  21. Symbol = [sfObjFlag flag:RawNum] [sfReadOnly]
  22. Type name:RawString
  23. Value = [ RawNum | RawHInt | RawReal | RawLReal | RawString ]
  24. Type = TypeReference
  25. | BasicType
  26. | ImportedType
  27. | UserType.
  28. TypeReference = number<0:RawNum
  29. BasicType = sfTypeBoolean | .. | sfLastType.
  30. ImportedType = ModuleNumber (structName:RawString | 0X typeIndex:RawNum)
  31. ModuleNumber = sfMod1 | .. | sfModOther-1 | sfModOther moduleNumber:RawNum
  32. UserType = [sfInvisible] [sfSysFlag sysFlag:RawNum] UserType2
  33. UserType2 = sfTypeOpenArray baseType:Type name:RawString
  34. | sfTypeStaticArray baseType:Type name:RawString length:RawNum
  35. | sfTypePointer baseType:Type name:RawString
  36. | sfTypeRecord baseType:Type name:RawString Record
  37. | sfTypeProcedure baseType:Type name:RawString flags:RawNum
  38. ParameterList
  39. Record = mode:RawNum priority:Char {variable:Symbol}
  40. [sfTProcedure {Symbol [name:RawString] ParameterList [sfInline Inline]} ]
  41. sfEnd.
  42. ParameterList = {
  43. [sfObjflag ( sfCParam | sfDarwinCParam | sfWinAPIParam )]
  44. [sfVar] [sfReadOnly] Type name:RawString
  45. } sfEnd.
  46. Inline = {len:Char {c:Char}} 0X.
  47. *)
  48. CONST
  49. TraceImport=0;
  50. TraceExport=1;
  51. Trace = {} ;
  52. (* FoxProgTools.Enum --start=1 sfTypeBoolean sfTypeChar8 sfTypeChar16 sfTypeChar32
  53. sfTypeShortint sfTypeInteger sfTypeLongint sfTypeHugeint sfTypeReal sfTypeLongreal sfTypeSet
  54. sfTypeString sfTypeNoType sfTypeNilType sfTypeByte sfTypeSptr sfMod1 ~
  55. FoxProgTools.Enum --start=2DH --hex sfModOther sfTypeOpenArray sfTypeStaticArray sfTypePointer sfTypeRecord sfTypeProcedure
  56. sfSysFlag sfInvisible sfReadOnly sfObjFlag sfConst sfVar sfLProcedure sfXProcedure sfOperator sfTProcedure sfCProcedure sfAlias sfType sfEnd ~
  57. *)
  58. sfTypeBoolean= 1;
  59. sfTypeChar8= 2;
  60. sfTypeChar16= 3;
  61. sfTypeChar32= 4;
  62. sfTypeShortint= 5;
  63. sfTypeInteger= 6;
  64. sfTypeLongint= 7;
  65. sfTypeHugeint = 8;
  66. sfTypeReal = 9;
  67. sfTypeLongreal = 10;
  68. sfTypeSet = 11;
  69. sfTypeString = 12;
  70. sfTypeNoType = 13;
  71. sfTypeNilType = 14;
  72. sfTypeByte = 15;
  73. sfTypeAny = 16;
  74. sfTypeObject = 17;
  75. sfTypeAddress= 18;
  76. sfTypeSize = 19;
  77. sfTypeUnsigned8=20;
  78. sfTypeUnsigned16=21;
  79. sfTypeUnsigned32=22;
  80. sfTypeUnsigned64=23;
  81. sfLastType = 23;
  82. sfMod1 = sfLastType+1;
  83. sfModOther=2DH;
  84. sfTypeOpenArray=2EH;
  85. (*
  86. sfTypeDynamicArray=2FH;
  87. *)
  88. sfTypeStaticArray=30H;
  89. sfTypePointer=31H;
  90. sfTypeRecord=32H;
  91. sfTypeProcedure=33H;
  92. sfSysFlag=34H;
  93. sfInvisible=35H;
  94. sfHidden = 0ACH;
  95. sfReadOnly=36H;
  96. sfObjFlag = 37H; (* fof: very (!) bad idea to have same number for two type flags *)
  97. sfConst=37H;
  98. sfVar=38H;
  99. sfTypeEnumeration=39H;
  100. (*
  101. sfLProcedure=39H;
  102. *)
  103. sfXProcedure=3AH;
  104. sfOperator=3BH;
  105. sfTProcedure=3CH;
  106. sfCProcedure = sfTProcedure;
  107. sfAlias=3DH;
  108. sfType=3EH;
  109. sfEnd= 3FH;
  110. sfTypeOpenMathArray = 40H;
  111. sfTypeTensor=42H;
  112. sfTypeStaticMathArray = 43H;
  113. sfTypeAll = 44H;
  114. sfTypeRange = 45H;
  115. sfTypeComplex = 46H;
  116. sfTypeLongcomplex = 47H;
  117. (* workaround: handle inlined operators *)
  118. sfInline = 0ABH;
  119. sfProtected = 0;
  120. sfActive=1;
  121. sfSafe=2;
  122. sfClass=16;
  123. sfDelegate = 5;
  124. sfUntraced = 4;
  125. sfWinAPIParam = 13; (* ejz *)
  126. sfCParam= 14; (* fof for linux *)
  127. sfDarwinCParam= 15; (* fld for darwin *)
  128. sfRealtime= 21;
  129. sfDynamic = 22;
  130. sfUnsafe= 23;
  131. sfDisposable= 24;
  132. sfFictive = 25;
  133. Undef=MIN(LONGINT);
  134. CONST
  135. FileTag = 0BBX; (* same constants are defined in Linker and AosLoader *)
  136. NoZeroCompress = 0ADX; (* do. *)
  137. FileVersion* = 0B1X; (* do. *)
  138. FileVersionOC*=0B2X;
  139. FileVersionCurrent*=0B4X;
  140. TYPE
  141. (* TypeReference provides a link between a type and a number for the purpose of late fixes while importing.
  142. When a type number is encountered while importing, a type reference will be used as a placeholder for the final type.
  143. After the import process has collected all types, the references are replaced by the referenced types (cf. Resolver Object) *)
  144. TypeReference = OBJECT (SyntaxTree.Type)
  145. VAR nr: LONGINT;
  146. PROCEDURE & InitTypeReference(nr: LONGINT);
  147. BEGIN
  148. InitType(Basic.invalidPosition); SELF.nr := nr;
  149. END InitTypeReference;
  150. END TypeReference;
  151. (* IndexToType provides a link between numbers and a type. Lists like this are typically filled while importing and provide the base
  152. for the type resolving, cf. Resolver below
  153. *)
  154. IndexToType= OBJECT(Basic.List)
  155. PROCEDURE PutType(nr: LONGINT; type: SyntaxTree.Type);
  156. BEGIN GrowAndSet(nr,type);
  157. END PutType;
  158. PROCEDURE GetType(nr: LONGINT): SyntaxTree.Type;
  159. VAR node: ANY;
  160. BEGIN node := Get(nr); IF node = NIL THEN RETURN NIL ELSE RETURN node(SyntaxTree.Type) END;
  161. END GetType;
  162. END IndexToType;
  163. LateFix= POINTER TO RECORD (* contains a late fix to be resolved in a later step: type fixes and implementations *)
  164. p: ANY; (*scope: SyntaxTree.Scope;*)
  165. next: LateFix;
  166. END;
  167. LateFixList = OBJECT (* fifo queue for items to be resolved later on - deferred fixes *)
  168. VAR first,last: LateFix;
  169. PROCEDURE & Init;
  170. BEGIN first := NIL; last := NIL;
  171. END Init;
  172. (* get and remove element from list *)
  173. PROCEDURE Get((*VAR scope: SyntaxTree.Scope*)): ANY;
  174. VAR p: ANY;
  175. BEGIN
  176. IF first # NIL THEN p := first.p; (*scope := first.scope;*) first := first.next ELSE p := NIL; END;
  177. IF first = NIL THEN last := NIL END;
  178. RETURN p;
  179. END Get;
  180. (* add unresolved type to list *)
  181. PROCEDURE Add(p: ANY (*; scope: SyntaxTree.Scope*));
  182. VAR next: LateFix;
  183. BEGIN
  184. (*ASSERT(scope # NIL);*)
  185. NEW(next); next.p := p; (* next.scope := scope;*)
  186. next.next := NIL;
  187. IF first = NIL THEN first := next; last := next;
  188. ELSE last.next := next; last := next
  189. END;
  190. END Add;
  191. END LateFixList;
  192. (*
  193. The resolver object is used to replace type references in a SyntaxTree.Module tree with the respective types from a given type list.
  194. To do so, the resolver traverses the module tree partially with direct procedural recursion and partially using the visitor pattern.
  195. *)
  196. Resolver=OBJECT (SyntaxTree.Visitor)
  197. VAR typeList: IndexToType; system: Global.System; typeFixes: LateFixList;
  198. checker: SemanticChecker.Checker;
  199. PROCEDURE & Init(system: Global.System; symbolFile: BinarySymbolFile; importCache: SyntaxTree.ModuleScope);
  200. VAR streamDiagnostics: Diagnostics.StreamDiagnostics;
  201. BEGIN
  202. typeList := NIL; SELF.system := system; NEW(typeFixes);
  203. NEW(streamDiagnostics, D.Log);
  204. checker := SemanticChecker.NewChecker(streamDiagnostics,FALSE,FALSE,TRUE,system,symbolFile,importCache,"");
  205. END Init;
  206. (* types that do not refer to other types *)
  207. PROCEDURE VisitType(x: SyntaxTree.Type);
  208. BEGIN END VisitType;
  209. PROCEDURE VisitBasicType(x: SyntaxTree.BasicType);
  210. BEGIN END VisitBasicType;
  211. PROCEDURE VisitByteType(x: SyntaxTree.ByteType);
  212. BEGIN END VisitByteType;
  213. PROCEDURE VisitBooleanType(x: SyntaxTree.BooleanType);
  214. BEGIN END VisitBooleanType;
  215. PROCEDURE VisitSetType(x: SyntaxTree.SetType);
  216. BEGIN END VisitSetType;
  217. PROCEDURE VisitAddressType(x: SyntaxTree.AddressType);
  218. BEGIN END VisitAddressType;
  219. PROCEDURE VisitSizeType(x: SyntaxTree.SizeType);
  220. BEGIN END VisitSizeType;
  221. PROCEDURE VisitAnyType(x: SyntaxTree.AnyType);
  222. BEGIN END VisitAnyType;
  223. PROCEDURE VisitObjectType(x: SyntaxTree.ObjectType);
  224. BEGIN END VisitObjectType;
  225. PROCEDURE VisitNilType(x: SyntaxTree.NilType);
  226. BEGIN END VisitNilType;
  227. PROCEDURE VisitCharacterType(x: SyntaxTree.CharacterType);
  228. BEGIN END VisitCharacterType;
  229. PROCEDURE VisitIntegerType(x: SyntaxTree.IntegerType);
  230. BEGIN END VisitIntegerType;
  231. PROCEDURE VisitFloatType(x: SyntaxTree.FloatType);
  232. BEGIN END VisitFloatType;
  233. PROCEDURE VisitComplexType(x: SyntaxTree.ComplexType);
  234. BEGIN END VisitComplexType;
  235. PROCEDURE VisitQualifiedType(x: SyntaxTree.QualifiedType);
  236. BEGIN
  237. x.SetResolved(ResolveType(x.resolved))
  238. END VisitQualifiedType;
  239. PROCEDURE VisitStringType(x: SyntaxTree.StringType);
  240. BEGIN END VisitStringType;
  241. PROCEDURE VisitRangeType(x: SyntaxTree.RangeType);
  242. BEGIN END VisitRangeType;
  243. (* types containing links to other types *)
  244. (**
  245. check enumeration scope: enter symbols and check for duplicate names
  246. **)
  247. PROCEDURE CheckEnumerationScope(x: SyntaxTree.EnumerationScope);
  248. VAR e: SyntaxTree.Constant; lowest, highest,value: LONGINT;
  249. BEGIN
  250. lowest := 0; highest := 0;
  251. e := x.firstConstant;
  252. WHILE (e # NIL) DO
  253. e.SetType(x.ownerEnumeration);
  254. e.SetState(SyntaxTree.Resolved);
  255. value := e.value(SyntaxTree.EnumerationValue).value;
  256. IF value < lowest THEN lowest := value END;
  257. IF value > highest THEN highest := value END;
  258. e := e.nextConstant;
  259. END;
  260. x.ownerEnumeration.SetRange(lowest,highest);
  261. END CheckEnumerationScope;
  262. (**
  263. resolve enumeration type: check enumeration scope
  264. **)
  265. PROCEDURE VisitEnumerationType(x: SyntaxTree.EnumerationType);
  266. VAR baseScope: SyntaxTree.EnumerationScope; resolved: SyntaxTree.Type; enumerationBase: SyntaxTree.EnumerationType;
  267. BEGIN
  268. x.SetEnumerationBase(ResolveType(x.enumerationBase));
  269. IF x.enumerationBase # NIL THEN
  270. resolved := x.enumerationBase.resolved;
  271. enumerationBase := resolved(SyntaxTree.EnumerationType);
  272. baseScope := enumerationBase.enumerationScope;
  273. END;
  274. CheckEnumerationScope(x.enumerationScope);
  275. x.SetState(SyntaxTree.Resolved);
  276. END VisitEnumerationType;
  277. PROCEDURE VisitArrayType(arrayType: SyntaxTree.ArrayType);
  278. BEGIN
  279. ASSERT(arrayType.arrayBase # NIL);
  280. arrayType.SetArrayBase(ResolveType(arrayType.arrayBase));
  281. arrayType.SetHasPointers(arrayType.arrayBase.resolved.hasPointers);
  282. arrayType.SetState(SyntaxTree.Resolved);
  283. END VisitArrayType;
  284. PROCEDURE VisitMathArrayType(arrayType: SyntaxTree.MathArrayType);
  285. BEGIN
  286. arrayType.SetArrayBase(ResolveType(arrayType.arrayBase));
  287. IF arrayType.form = SyntaxTree.Static THEN
  288. arrayType.SetIncrement(system.SizeOf(arrayType.arrayBase));
  289. arrayType.SetHasPointers(arrayType.arrayBase.resolved.hasPointers);
  290. ELSE
  291. arrayType.SetHasPointers(TRUE)
  292. END;
  293. arrayType.SetState(SyntaxTree.Resolved);
  294. END VisitMathArrayType;
  295. PROCEDURE VisitPointerType(pointerType: SyntaxTree.PointerType);
  296. VAR recordType: SyntaxTree.RecordType;
  297. BEGIN
  298. IF ~(SyntaxTree.Resolved IN pointerType.state) THEN
  299. typeFixes.Add(pointerType);
  300. pointerType.SetState(SyntaxTree.Resolved);
  301. END;
  302. (*
  303. pointerType.SetPointerBase(ResolveType(pointerType.pointerBase));
  304. IF pointerType.pointerBase.resolved IS SyntaxTree.RecordType THEN
  305. recordType := pointerType.pointerBase.resolved(SyntaxTree.RecordType);
  306. IF (recordType.typeDeclaration = NIL) THEN
  307. recordType.SetPointerType(pointerType);
  308. recordType.SetTypeDeclaration(pointerType.typeDeclaration)
  309. END;
  310. END;
  311. pointerType.SetState(SyntaxTree.Resolved);
  312. *)
  313. END VisitPointerType;
  314. PROCEDURE FixPointerType(pointerType: SyntaxTree.PointerType);
  315. VAR recordType: SyntaxTree.RecordType;
  316. BEGIN
  317. pointerType.SetPointerBase(ResolveType(pointerType.pointerBase));
  318. IF pointerType.pointerBase.resolved IS SyntaxTree.RecordType THEN
  319. recordType := pointerType.pointerBase.resolved(SyntaxTree.RecordType);
  320. IF (recordType.typeDeclaration = NIL) THEN
  321. recordType.SetPointerType(pointerType);
  322. recordType.SetTypeDeclaration(pointerType.typeDeclaration)
  323. END;
  324. END;
  325. END FixPointerType;
  326. PROCEDURE VisitRecordType(recordType: SyntaxTree.RecordType);
  327. VAR recordBase: SyntaxTree.RecordType; numberMethods: LONGINT; procedure,super,testsuper: SyntaxTree.Procedure; recordScope: SyntaxTree.RecordScope;
  328. pointerType: SyntaxTree.Type; typeDeclaration: SyntaxTree.TypeDeclaration; symbol: SyntaxTree.Symbol; size: HUGEINT; hasPointer: BOOLEAN;
  329. var: SyntaxTree.Variable;
  330. BEGIN
  331. recordType.SetBaseType(ResolveType(recordType.baseType));
  332. recordScope := recordType.recordScope;
  333. recordBase := recordType.GetBaseRecord();
  334. hasPointer := FALSE;
  335. IF recordBase = NIL THEN numberMethods := 0;
  336. ELSE
  337. recordBase.Accept(SELF); numberMethods := recordBase.recordScope.numberMethods;
  338. END;
  339. symbol := recordScope.firstSymbol; (* must use the sorted list here, important! *)
  340. WHILE symbol # NIL DO
  341. IF (symbol IS SyntaxTree.Procedure) THEN
  342. procedure := symbol(SyntaxTree.Procedure);
  343. IF procedure IS SyntaxTree.Operator THEN FixProcedureType(procedure.type(SyntaxTree.ProcedureType)) END;
  344. super := SemanticChecker.FindSuperProcedure(recordScope, procedure);
  345. procedure.SetSuper(super);
  346. IF super # NIL THEN
  347. procedure.SetAccess(procedure.access+super.access);
  348. END;
  349. IF procedure.super # NIL THEN
  350. procedure.SetMethodNumber(procedure.super.methodNumber)
  351. ELSE
  352. procedure.SetMethodNumber(numberMethods);
  353. INC(numberMethods);
  354. END;
  355. END;
  356. symbol := symbol.nextSymbol;
  357. END;
  358. recordScope.SetNumberMethods(numberMethods);
  359. IF (recordScope.firstProcedure # NIL) OR (recordBase # NIL) & (recordBase.isObject) THEN
  360. recordType.IsObject(TRUE)
  361. END;
  362. IF (recordBase # NIL) & recordBase.hasPointers THEN hasPointer := TRUE END;
  363. Scope(recordType.recordScope);
  364. var := recordType.recordScope.firstVariable;
  365. WHILE var # NIL DO
  366. hasPointer := hasPointer OR var.type.resolved.hasPointers & ~var.untraced;
  367. var := var.nextVariable;
  368. END;
  369. recordType.SetHasPointers(hasPointer);
  370. checker.SetCurrentScope(recordType.recordScope);
  371. checker.ResolveArrayStructure(recordType);
  372. recordType.SetState(SyntaxTree.Resolved);
  373. size := system.SizeOf(recordType); (* generate field offsets *)
  374. IF (recordType.typeDeclaration = NIL) & (recordType.pointerType # NIL) THEN
  375. pointerType := recordType.pointerType.resolved;
  376. typeDeclaration := pointerType.typeDeclaration;
  377. recordType.SetTypeDeclaration(typeDeclaration);
  378. END;
  379. END VisitRecordType;
  380. PROCEDURE VisitProcedureType(procedureType: SyntaxTree.ProcedureType);
  381. VAR parameter: SyntaxTree.Parameter;
  382. BEGIN
  383. IF ~(SyntaxTree.Resolved IN procedureType.state) THEN
  384. typeFixes.Add(procedureType);
  385. IF procedureType.isDelegate THEN
  386. procedureType.SetHasPointers(TRUE);
  387. END;
  388. procedureType.SetState(SyntaxTree.Resolved);
  389. END;
  390. END VisitProcedureType;
  391. PROCEDURE FixProcedureType(procedureType: SyntaxTree.ProcedureType);
  392. VAR parameter: SyntaxTree.Parameter; returnType: SyntaxTree.Type;
  393. BEGIN
  394. (* parameter list *)
  395. parameter := procedureType.firstParameter;
  396. WHILE(parameter # NIL) DO
  397. parameter.SetType(ResolveType(parameter.type));
  398. parameter := parameter.nextParameter;
  399. END;
  400. (* return type *)
  401. returnType := ResolveType(procedureType.returnType);
  402. procedureType.SetReturnType(ResolveType(returnType));
  403. IF returnType# NIL THEN
  404. parameter := SyntaxTree.NewParameter(Basic.invalidPosition,procedureType,Global.ReturnParameterName,SyntaxTree.VarParameter);
  405. parameter.SetType(returnType);
  406. parameter.SetState(SyntaxTree.Resolved);
  407. procedureType.SetReturnParameter(parameter);
  408. END;
  409. END FixProcedureType;
  410. (* a type reference is resolved by replacing it with the respective element of the type list, all other types remain *)
  411. PROCEDURE ResolveType(type: SyntaxTree.Type): SyntaxTree.Type;
  412. BEGIN
  413. IF type = NIL THEN RETURN NIL
  414. ELSIF (type IS TypeReference) THEN
  415. type := typeList.GetType(type(TypeReference).nr);
  416. END;
  417. IF ~(SyntaxTree.Resolved IN type.state) THEN
  418. type.Accept(SELF);
  419. type.SetState(SyntaxTree.Resolved);
  420. END;
  421. RETURN type;
  422. END ResolveType;
  423. (** resolve all pending types (late resolving).
  424. - type fixes are resolved at the end of the declaration phase
  425. - type fixes may imply new type fixes that are also entered at the end of the list
  426. **)
  427. PROCEDURE FixTypes;
  428. VAR p: ANY; prevScope: SyntaxTree.Scope;
  429. BEGIN
  430. (*prevScope := currentScope;*)
  431. p := typeFixes.Get((*currentScope*));
  432. WHILE p # NIL DO
  433. ASSERT(p IS SyntaxTree.Type);
  434. IF p IS SyntaxTree.PointerType THEN
  435. FixPointerType(p(SyntaxTree.PointerType))
  436. ELSIF p IS SyntaxTree.ProcedureType THEN
  437. FixProcedureType(p(SyntaxTree.ProcedureType))
  438. ELSE
  439. HALT(100);
  440. END;
  441. p := typeFixes.Get((*currentScope*));
  442. END;
  443. (*currentScope :=prevScope;*)
  444. END FixTypes;
  445. (* scope traversal *)
  446. PROCEDURE Scope(scope: SyntaxTree.Scope);
  447. VAR typeDeclaration: SyntaxTree.TypeDeclaration; variable: SyntaxTree.Variable; procedure: SyntaxTree.Procedure;
  448. BEGIN
  449. (* type declarations *)
  450. typeDeclaration := scope.firstTypeDeclaration;
  451. WHILE(typeDeclaration # NIL) DO
  452. typeDeclaration.SetDeclaredType(ResolveType(typeDeclaration.declaredType));
  453. IF ~(typeDeclaration.declaredType IS SyntaxTree.BasicType) THEN
  454. typeDeclaration.declaredType.SetTypeDeclaration(typeDeclaration);
  455. END;
  456. typeDeclaration := typeDeclaration.nextTypeDeclaration;
  457. END;
  458. (* variables *)
  459. variable := scope.firstVariable;
  460. WHILE(variable # NIL) DO
  461. variable.SetType(ResolveType(variable.type));
  462. ASSERT (~(variable.type IS TypeReference));
  463. ASSERT(~(variable.type.resolved IS TypeReference));
  464. variable := variable.nextVariable;
  465. END;
  466. (* procedures *)
  467. procedure := scope.firstProcedure;
  468. WHILE(procedure # NIL) DO
  469. Scope(procedure.procedureScope);
  470. procedure.SetType(ResolveType(procedure.type));
  471. procedure := procedure.nextProcedure;
  472. END;
  473. END Scope;
  474. (* replace all TypeReferences in module by referenced types in typeList *)
  475. PROCEDURE Resolve(module: SyntaxTree.Module; typeList: IndexToType);
  476. BEGIN
  477. SELF.typeList := typeList;
  478. Scope(module.moduleScope);
  479. FixTypes;
  480. module.SetState(SyntaxTree.Resolved);
  481. END Resolve;
  482. END Resolver;
  483. (*
  484. An Index is the data structure containing a number to be mapped to types via the object TypeToIndex below.
  485. Used for type enumeration when exporting.
  486. *)
  487. Index =POINTER TO RECORD tag: LONGINT END;
  488. (*
  489. The TypeToIndex object provides the link between a type and a module and type number. It is the inverse of the IndexToType and is used
  490. for exporting. It is implemented using a hash table mapping a SyntaxTree.Type to a Index object.
  491. *)
  492. TypeToIndex= OBJECT (Basic.HashTable)
  493. PROCEDURE GetIndex(type: SyntaxTree.Type): LONGINT;
  494. VAR t:ANY;
  495. BEGIN
  496. t := Get(type);
  497. IF t # NIL THEN RETURN t(Index).tag ELSE RETURN Undef END;
  498. END GetIndex;
  499. PROCEDURE PutIndex(type:SyntaxTree.Type; nr: LONGINT);
  500. VAR t: Index;
  501. BEGIN
  502. ASSERT(nr # Undef);
  503. NEW(t); t.tag := nr; Put(type,t);
  504. END PutIndex;
  505. END TypeToIndex;
  506. Attribute = OBJECT
  507. VAR
  508. numberTypes: LONGINT;
  509. indexToType: IndexToType;
  510. typeToIndex: TypeToIndex;
  511. PROCEDURE &Init;
  512. BEGIN numberTypes := 0; NEW(indexToType,16); NEW(typeToIndex,100);
  513. END Init;
  514. END Attribute;
  515. IndexToAttribute= OBJECT(Basic.List)
  516. PROCEDURE PutAttribute(nr: LONGINT; attribute: Attribute);
  517. BEGIN GrowAndSet(nr,attribute);
  518. END PutAttribute;
  519. PROCEDURE GetAttribute(nr: LONGINT): Attribute;
  520. VAR node: ANY; attribute: Attribute;
  521. BEGIN
  522. IF Length() <= nr THEN node := NIL ELSE node := Get(nr) END;
  523. IF node # NIL THEN attribute := node(Attribute)
  524. ELSE NEW(attribute); PutAttribute(nr,attribute);
  525. END;
  526. RETURN attribute
  527. END GetAttribute;
  528. END IndexToAttribute;
  529. BinarySymbolFile*=OBJECT (Formats.SymbolFileFormat)
  530. VAR file-: Files.File; extension-: Basic.FileName;
  531. noRedefinition, noModification, noInterfaceCheck: BOOLEAN;
  532. version: CHAR;
  533. (** Import - Symbol Table Loader Plugin *)
  534. PROCEDURE Import(CONST moduleName: ARRAY OF CHAR; importCache: SyntaxTree.ModuleScope): SyntaxTree.Module;
  535. VAR
  536. module: SyntaxTree.Module;
  537. moduleIdentifier,contextIdentifier: SyntaxTree.Identifier;
  538. moduleScope: SyntaxTree.ModuleScope;
  539. fileName: Files.FileName;
  540. R: Streams.Reader;
  541. tag, i: LONGINT;
  542. visibility: SET;
  543. type: SyntaxTree.Type;
  544. variable: SyntaxTree.Variable;
  545. constant: SyntaxTree.Constant;
  546. procedure: SyntaxTree.Procedure;
  547. procedureType: SyntaxTree.ProcedureType;
  548. procedureScope: SyntaxTree.ProcedureScope;
  549. typeDeclaration: SyntaxTree.TypeDeclaration;
  550. resolver: Resolver;
  551. allTypes: IndexToType; numberReimports, numberTypes : LONGINT;
  552. name: SyntaxTree.IdentifierString;
  553. value: SyntaxTree.Value;
  554. stamp: LONGINT;
  555. b: BOOLEAN;
  556. indexToAttribute: IndexToAttribute;
  557. predefType: ARRAY sfLastType+1 OF SyntaxTree.Type;
  558. PROCEDURE NewTypeReference(nr: LONGINT): SyntaxTree.Type;
  559. VAR typeReference: TypeReference;
  560. BEGIN
  561. NEW(typeReference,nr); RETURN typeReference;
  562. END NewTypeReference;
  563. (* Imports = {moduleName:RawString} 0X *)
  564. PROCEDURE Imports;
  565. VAR moduleName: SyntaxTree.IdentifierString; import: SyntaxTree.Import; importedModule: SyntaxTree.Module; moduleIdentifier,moduleContext: SyntaxTree.Identifier; b: BOOLEAN;
  566. BEGIN
  567. R.RawString(moduleName);
  568. WHILE moduleName # "" DO
  569. ASSERT(moduleName # "SYSTEM");
  570. IF TraceImport IN Trace THEN D.Str("import module: "); D.Str(moduleName); D.Ln; END;
  571. (* as the context is not encoded in the symbol file, we have to deduce it from the filename, this is ugly but necessary
  572. to keep consistency with old compiler
  573. *)
  574. Global.ContextFromName(moduleName,moduleIdentifier,moduleContext);
  575. import := importCache.ImportByModuleName(moduleIdentifier,moduleContext);
  576. IF import # NIL THEN
  577. IF import.module = NIL THEN (* has not yet been imported by parent module *)
  578. (* adjust import symbol in parent *)
  579. importedModule := Import(moduleName,importCache);
  580. import.SetModule(importedModule);
  581. ELSE
  582. (* take module from parent *)
  583. importedModule := import.module;
  584. END
  585. ELSE
  586. importedModule := Import(moduleName,importCache);
  587. IF importedModule # NIL THEN
  588. import := SyntaxTree.NewImport(Basic.invalidPosition,importedModule.name,importedModule.name,FALSE);
  589. import.SetContext(importedModule.context);
  590. import.SetModule(importedModule);
  591. import.SetState(SyntaxTree.Resolved);
  592. importCache.AddImport(import);
  593. END;
  594. END;
  595. (* create new import symbol for this module scope *)
  596. IF importedModule # NIL THEN
  597. import := SyntaxTree.NewImport(Basic.invalidPosition,moduleIdentifier,moduleIdentifier,TRUE);
  598. import.SetModule(importedModule);
  599. import.SetContext(moduleContext);
  600. import.SetState(SyntaxTree.Resolved);
  601. module.moduleScope.AddImport(import);
  602. module.moduleScope.EnterSymbol(import,b);
  603. END;
  604. R.RawString(moduleName);
  605. END
  606. END Imports;
  607. (* Value = [ RawNum | RawHInt | RawReal | RawLReal | RawString ] *)
  608. PROCEDURE Value(type: SyntaxTree.Type): SyntaxTree.Value;
  609. VAR i: LONGINT; huge: HUGEINT; r: REAL; lr: LONGREAL; string: SyntaxTree.String; length: LONGINT; set: SET;
  610. value: SyntaxTree.Value; size: LONGINT;
  611. BEGIN
  612. size := type.sizeInBits;
  613. IF type IS SyntaxTree.BooleanType THEN R.RawNum(i);
  614. IF TraceImport IN Trace THEN D.Str("InConst / Bool / "); D.Int(i,1); D.Ln; END;
  615. IF i = 0 THEN value := Global.NewBooleanValue(system,Basic.invalidPosition,FALSE) ELSE value := Global.NewBooleanValue(system,Basic.invalidPosition,TRUE) END
  616. ELSIF (type IS SyntaxTree.CharacterType) THEN
  617. IF (size=8) OR (size=16) OR (size=32) THEN
  618. R.RawNum(i);
  619. IF TraceImport IN Trace THEN D.Str("InConst / Char / "); D.Int(i,1); D.Ln; END;
  620. value := SyntaxTree.NewCharacterValue(Basic.invalidPosition,CHR(i));
  621. END;
  622. ELSIF type IS SyntaxTree.IntegerType THEN
  623. IF (size = 32) & ~type(SyntaxTree.IntegerType).signed THEN
  624. R.RawHInt(huge);
  625. IF TraceImport IN Trace THEN D.Str("InConst / Unsigned32 / "); D.Ln END;
  626. value := SyntaxTree.NewIntegerValue (Basic.invalidPosition,huge);
  627. ELSIF size <=32 THEN
  628. R.RawNum(i);
  629. IF TraceImport IN Trace THEN D.Str("InConst / Int"); D.Int(size,1); D.String(" "); D.Int(i,1); D.Ln END;
  630. value := SyntaxTree.NewIntegerValue(Basic.invalidPosition,i);
  631. ELSIF size=64 THEN
  632. R.RawHInt(huge);
  633. IF TraceImport IN Trace THEN D.Str("InConst / HInt / "); D.Ln END;
  634. value := SyntaxTree.NewIntegerValue (Basic.invalidPosition,huge);
  635. END;
  636. ELSIF type IS SyntaxTree.SetType THEN R.RawNum(SYSTEM.VAL(LONGINT, set));
  637. IF TraceImport IN Trace THEN D.Str("InConst / Set / "); D.Hex(SYSTEM.VAL(LONGINT, set),1); D.Ln END;
  638. value := SyntaxTree.NewSetValue(Basic.invalidPosition,set);
  639. ELSIF type IS SyntaxTree.FloatType THEN
  640. IF size = 32 THEN
  641. R.RawReal(r);
  642. IF TraceImport IN Trace THEN D.Str("InConst / Real / "); D.Ln END;
  643. value := SyntaxTree.NewRealValue(Basic.invalidPosition,r);
  644. ELSIF size = 64 THEN
  645. R.RawLReal(lr);
  646. IF TraceImport IN Trace THEN D.Str("InConst / LongReal / "); D.Ln END;
  647. value := SyntaxTree.NewRealValue(Basic.invalidPosition,lr);
  648. END;
  649. ELSIF type IS SyntaxTree.StringType THEN
  650. IF version <= FileVersionOC THEN NEW(string, 256)
  651. ELSE R.RawLInt(length); NEW(string, length)
  652. END;
  653. R.RawString(string^);
  654. IF TraceImport IN Trace THEN D.Str("InConst / String / "); D.Str(string^); D.Ln END;
  655. value := SyntaxTree.NewStringValue(Basic.invalidPosition,string);
  656. type(SyntaxTree.StringType).SetLength(value(SyntaxTree.StringValue).length);
  657. type.SetState(SyntaxTree.Resolved);
  658. ELSIF type IS SyntaxTree.EnumerationType THEN R.RawNum(i);
  659. IF TraceImport IN Trace THEN D.Str("InConst / LInt / "); D.Int(i,1); D.Ln END;
  660. value := SyntaxTree.NewEnumerationValue(Basic.invalidPosition,i);
  661. ELSIF type IS SyntaxTree.NilType THEN
  662. IF TraceImport IN Trace THEN D.Str("InConst / Nil"); D.Ln END;
  663. value := SyntaxTree.NewNilValue(Basic.invalidPosition);
  664. END;
  665. value.SetType(type);
  666. value.SetState(SyntaxTree.Resolved);
  667. RETURN value
  668. END Value;
  669. (* EnumerationList = {name:RawString} sfEnd *)
  670. PROCEDURE EnumerationList(enumerationScope: SyntaxTree.EnumerationScope);
  671. VAR enumerator: SyntaxTree.Constant; visibility,flags: SET; b: BOOLEAN;
  672. type: SyntaxTree.Type; name: SyntaxTree.IdentifierString; identifier: SyntaxTree.Identifier;
  673. BEGIN
  674. R.RawString(name);
  675. WHILE name # "" DO
  676. identifier := SyntaxTree.NewIdentifier(name);
  677. enumerator := SyntaxTree.NewConstant(Basic.invalidPosition,identifier);
  678. enumerationScope.AddConstant(enumerator);
  679. enumerationScope.EnterSymbol(enumerator,b);
  680. IF name # "@" THEN enumerationScope.lastConstant.SetAccess(SyntaxTree.Public+SyntaxTree.Internal+SyntaxTree.Protected)
  681. ELSE enumerationScope.lastConstant.SetAccess(SyntaxTree.Internal)
  682. END;
  683. value := Value(enumerationScope.ownerEnumeration);
  684. enumerator.SetValue(value);
  685. enumerator.SetType(enumerationScope.ownerEnumeration);
  686. R.RawString(name);
  687. END;
  688. END EnumerationList;
  689. (* ParameterList = { [sfObjflag ( sfCParam | sfDarwinCParam | sfWinAPIParam )] [sfVar] [sfReadOnly] Type name:RawString } sfEnd *)
  690. PROCEDURE ParameterList(VAR callingConvention: LONGINT; parentScope: SyntaxTree.Scope; procedureType: SyntaxTree.ProcedureType);
  691. VAR name: SyntaxTree.IdentifierString; type: SyntaxTree.Type; f: LONGINT;
  692. kind: LONGINT;
  693. parameter: SyntaxTree.Parameter;
  694. BEGIN
  695. IF TraceImport IN Trace THEN
  696. D.Str("ParameterList "); D.Ln
  697. END;
  698. callingConvention := SyntaxTree.OberonCallingConvention;
  699. R.RawNum(tag);
  700. WHILE tag#sfEnd DO
  701. IF tag = sfObjFlag THEN (*! the calling convention should not be expressed via the parameters (compatiblity with old compiler) *)
  702. R.RawNum(f);
  703. IF f = sfCParam THEN (* fof for Linux *)
  704. callingConvention := SyntaxTree.CCallingConvention
  705. ELSIF f = sfDarwinCParam THEN (* fld for darwin *)
  706. callingConvention := SyntaxTree.DarwinCCallingConvention
  707. ELSIF f=sfWinAPIParam THEN
  708. callingConvention := SyntaxTree.WinAPICallingConvention
  709. ELSE HALT(100)
  710. END;
  711. R.RawNum(tag);
  712. END;
  713. IF tag=sfVar THEN
  714. R.RawNum(tag);
  715. kind := SyntaxTree.VarParameter;
  716. ELSE
  717. kind := SyntaxTree.ValueParameter;
  718. END;
  719. IF tag = sfReadOnly THEN (* var const *)
  720. R.RawNum(tag);
  721. kind := SyntaxTree.ConstParameter;
  722. END;
  723. type := Type();
  724. R.RawString(name);
  725. parameter := SyntaxTree.NewParameter(Basic.invalidPosition,procedureType,SyntaxTree.NewIdentifier(name),kind);
  726. parameter.SetType(type);
  727. parameter.SetState(SyntaxTree.Resolved);
  728. (*! remove this after a rebuild of the release - for compatibility only *)
  729. IF (parameter.name=Global.SelfParameterName)
  730. OR (parameter.name=Global.ReturnParameterName)
  731. OR (parameter.name=Global.PointerReturnName)
  732. OR (parameter.name=Global.ResultName) THEN (* ignore *)
  733. ELSE
  734. procedureType.AddParameter(parameter);
  735. END;
  736. R.RawNum(tag)
  737. END;
  738. IF callingConvention # SyntaxTree.OberonCallingConvention THEN
  739. procedureType.RevertParameters;
  740. END;
  741. END ParameterList;
  742. (* returns the index of module importedModule in the list of module module *)
  743. PROCEDURE ModuleByIndex(module: SyntaxTree.Module; index: LONGINT): SyntaxTree.Module;
  744. VAR import: SyntaxTree.Import;
  745. BEGIN import := module.moduleScope.firstImport;
  746. WHILE (import # NIL) & (index > 0) DO
  747. IF (* (import.direct) & *) ~Global.IsSystemModule(import.module) THEN DEC(index) END;
  748. import := import.nextImport;
  749. END;
  750. ASSERT(import # NIL);
  751. (* ASSERT(import.direct); *)
  752. RETURN import.module;
  753. END ModuleByIndex;
  754. (*
  755. Record =
  756. mode:RawNum priority:Char {variable:Symbol}
  757. [sfTProcedure {Symbol [name:RawString] ParameterList [sfInline Inline]} ]
  758. sfEnd
  759. *)
  760. PROCEDURE Record(recordType: SyntaxTree.RecordType; baseType: SyntaxTree.Type);
  761. VAR
  762. mode: SET;
  763. priority: LONGINT;
  764. visibility: SET;
  765. active, safe, isOperator, isDynamic, isFictive: BOOLEAN;
  766. untraced, realtime, constructor: BOOLEAN;
  767. fOffset: LONGINT;
  768. variable: SyntaxTree.Variable;
  769. procedure: SyntaxTree.Procedure;
  770. operator: SyntaxTree.Operator;
  771. procedureType: SyntaxTree.ProcedureType;
  772. recordScope: SyntaxTree.RecordScope;
  773. recordBody: SyntaxTree.Body;
  774. name: SyntaxTree.IdentifierString;
  775. ch: CHAR;
  776. callingConvention: LONGINT;
  777. BEGIN
  778. recordScope := recordType.recordScope;
  779. R.RawNum(SYSTEM.VAL(LONGINT, mode));
  780. IF sfActive IN mode THEN active := TRUE ELSE active := FALSE END;
  781. IF sfProtected IN mode THEN recordType.SetProtected(TRUE) END;
  782. IF sfSafe IN mode THEN safe := TRUE ELSE safe := FALSE END;
  783. R.Char(ch);
  784. priority := ORD(ch); (* body priority, if active object *)
  785. IF TraceImport IN Trace THEN
  786. D.Str("Rec / Mode / "); D.Hex(SYSTEM.VAL(LONGINT, mode),1); D.Ln;
  787. D.Str("Rec / Prio / "); D.Int(priority,1); D.Ln
  788. END;
  789. R.RawNum(tag);
  790. WHILE (tag < sfTProcedure) OR (tag > sfEnd) DO (*read fields*)
  791. isOperator := FALSE;
  792. Symbol(recordScope,type,name,visibility,untraced, realtime, constructor, isOperator, isDynamic, isFictive, fOffset);
  793. ASSERT(type # NIL);
  794. IF name = "" THEN visibility := SyntaxTree.Internal END;
  795. variable := SyntaxTree.NewVariable(Basic.invalidPosition,SyntaxTree.NewIdentifier(name));
  796. variable.SetType(type);
  797. variable.SetUntraced(untraced);
  798. variable.SetAccess(visibility);
  799. IF isFictive THEN
  800. TRACE(fOffset);
  801. variable.SetFictive(fOffset);
  802. variable.SetUntraced(TRUE);
  803. END;
  804. variable.SetState(SyntaxTree.Resolved);
  805. recordScope.AddVariable(variable);
  806. recordScope.EnterSymbol(variable,b);
  807. R.RawNum(tag);
  808. END;
  809. IF tag=sfTProcedure THEN
  810. R.RawNum(tag);
  811. WHILE tag#sfEnd DO
  812. isOperator := FALSE;
  813. Symbol(recordScope,type,name, visibility,untraced, realtime, constructor, isOperator, isDynamic, isFictive, fOffset);
  814. IF name = "" THEN R.RawString(name) END;
  815. procedureScope := SyntaxTree.NewProcedureScope(recordScope);
  816. IF isOperator THEN
  817. operator := SyntaxTree.NewOperator(Basic.invalidPosition,SyntaxTree.NewIdentifier(name),procedureScope);
  818. procedure := operator
  819. ELSE
  820. procedure := SyntaxTree.NewProcedure(Basic.invalidPosition,SyntaxTree.NewIdentifier(name),procedureScope);
  821. END;
  822. procedureType := SyntaxTree.NewProcedureType(Basic.invalidPosition,recordScope);
  823. procedureType.SetReturnType(type);
  824. procedureType.SetRealtime(realtime);
  825. procedure.SetConstructor(constructor);
  826. procedureType.SetDelegate(TRUE);
  827. procedure.SetType(procedureType);
  828. procedure.SetAccess(visibility);
  829. procedure.SetState(SyntaxTree.Resolved);
  830. IF constructor THEN
  831. recordScope.SetConstructor(procedure); (*! redundant *)
  832. END;
  833. ParameterList(callingConvention,procedureScope,procedureType);
  834. recordScope.AddProcedure(procedure);
  835. IF isOperator THEN
  836. recordScope.AddOperator(operator);
  837. END;
  838. recordScope.EnterSymbol(procedure,b);
  839. (* This identifies a inlined Indexer *)
  840. R.RawNum(tag);
  841. IF tag = sfInline THEN
  842. Inline(procedureScope);
  843. (*
  844. INCL(flag, SyntaxTree.Inline);
  845. INCL(flag, SyntaxTree.Indexer);
  846. INCL(flag, SyntaxTree.Operator);
  847. mscope.code := Inline();
  848. *)
  849. R.RawNum(tag)
  850. END;
  851. IF (procedure.name=Global.RecordBodyName) THEN
  852. recordScope.SetBodyProcedure(procedure);
  853. recordBody := SyntaxTree.NewBody(Basic.invalidPosition,procedureScope);
  854. recordBody.SetSafe(safe);
  855. recordBody.SetActive(active);
  856. procedureScope.SetBody(recordBody);
  857. END;
  858. END
  859. ELSE ASSERT(tag = sfEnd);
  860. END;
  861. (*
  862. ASSERT((bodyFlags = {}) OR (recordScope.bodyProcedure # NIL));
  863. *)
  864. recordType.SetBaseType(baseType);
  865. END Record;
  866. (*
  867. Type =
  868. TypeReference
  869. |BasicType
  870. |ImportedType
  871. |UserType.
  872. TypeReference = number:RawNum(<0)
  873. BasicType = sfTypeBoolean | .. | sfLastType.
  874. ImportedType = ModuleNumber (structName:RawString | 0X typeIndex:RawNum)
  875. ModuleNumber = sfMod1 | .. | sfModOther-1 | sfModOther moduleNumber:RawNum
  876. UserType = [sfInvisible] [sfSysFlag sysFlag:RawNum] UserType2
  877. UserType2=
  878. sfTypeOpenArray baseType:Type name:RawString flags:RawNum
  879. |sfTypeStaticArray baseType:Type name:RawString flags:RawNum length:RawNum
  880. |sfOpenMathArray baseType:Type name:RawString
  881. |sfStaticMathArray baseType:Type name:RawString length:RawNum
  882. |sfTypeTensor baseType:Type name:RawString
  883. |sfTypePointer baseType:Type name:RawString flags:RawNum
  884. |sfTypeRecord baseType:Type name:RawString flags:RawNum Record
  885. |sfTypeProcedure baseType:Type name:RawString flags:RawNum ParameterList
  886. |sfTypeEnumeration enumerationBase:Type name:RawString
  887. *)
  888. PROCEDURE Type(): SyntaxTree.Type;
  889. VAR
  890. typtag,len: LONGINT;
  891. name: SyntaxTree.IdentifierString;
  892. type, baseType: SyntaxTree.Type;
  893. typeDeclaration: SyntaxTree.TypeDeclaration;
  894. arrayType: SyntaxTree.ArrayType;
  895. mathArrayType: SyntaxTree.MathArrayType;
  896. pointerType: SyntaxTree.PointerType;
  897. procedureType: SyntaxTree.ProcedureType;
  898. recordType: SyntaxTree.RecordType;
  899. recordScope: SyntaxTree.RecordScope;
  900. qualifiedType: SyntaxTree.QualifiedType;
  901. enumerationScope: SyntaxTree.EnumerationScope;
  902. enumerationType: SyntaxTree.EnumerationType;
  903. (*import: SyntaxTree.Import;*)
  904. importedModule: SyntaxTree.Module;
  905. identifier: SyntaxTree.Identifier;
  906. thisIndex : LONGINT;
  907. typeAdr: LONGINT;
  908. size: SyntaxTree.Value;
  909. visibility: SET;
  910. typeName: SyntaxTree.IdentifierString;
  911. sysflag: LONGINT; flags: SET;
  912. attribute: Attribute;
  913. callingConvention: LONGINT;
  914. BEGIN
  915. visibility := SyntaxTree.Public + SyntaxTree.Protected + SyntaxTree.Internal; flags := {};
  916. IF tag <= 0 THEN (* TypeReference = number:RawNum(<0) *)
  917. type := NewTypeReference(-tag);
  918. IF TraceImport IN Trace THEN
  919. D.Str("Type / OldStr "); D.Int(-tag,1); D.Ln
  920. END
  921. ELSIF tag = sfTypeString THEN
  922. type := SyntaxTree.NewStringType(Basic.invalidPosition,system.characterType,0);
  923. IF TraceImport IN Trace THEN
  924. D.Str("Type / String "); D.Int(tag,1); D.Ln
  925. END
  926. ELSIF tag <= sfLastType THEN (* BasicType = sfTypeBoolean | .. | sfLastType. *)
  927. type := predefType[tag];
  928. ASSERT((tag = sfTypeNoType) OR (type # NIL));
  929. IF TraceImport IN Trace THEN
  930. D.Str("Type / Basic "); D.Int(tag,1); D.Ln
  931. END
  932. ELSIF tag = sfTypeRange THEN
  933. type := system.rangeType;
  934. ELSIF tag = sfTypeComplex THEN
  935. type := system.complexType;
  936. ELSIF tag = sfTypeLongcomplex THEN
  937. type := system.longcomplexType;
  938. ELSIF tag <= sfModOther THEN
  939. (* ImportedType = ModuleNumber (structName:RawString | 0X typeIndex:RawNum) *)
  940. (* ModuleNumber = sfMod1 | .. | sfModOther-1 | sfModOther moduleNumber:RawNum *)
  941. IF tag = sfModOther THEN
  942. R.RawNum(tag);
  943. ASSERT(tag >= 0);
  944. ELSE
  945. tag := tag-sfMod1
  946. END; (*tag = [0 .. +oo[ *)
  947. importedModule := ModuleByIndex(module,tag);
  948. ASSERT(importedModule # NIL);
  949. R.RawString(typeName);
  950. type := NIL;
  951. attribute := indexToAttribute.GetAttribute(tag);
  952. IF typeName # "" THEN (* first import of struct *)
  953. identifier := SyntaxTree.NewIdentifier(typeName);
  954. typeDeclaration := importedModule.moduleScope.FindTypeDeclaration(identifier); (* find type in module *)
  955. IF (typeDeclaration # NIL) THEN
  956. qualifiedType := SyntaxTree.NewQualifiedType(Basic.invalidPosition,moduleScope,SyntaxTree.NewQualifiedIdentifier(Basic.invalidPosition,importedModule.name,identifier));
  957. qualifiedType.SetResolved(typeDeclaration.declaredType);
  958. qualifiedType.SetTypeDeclaration(typeDeclaration);
  959. type := qualifiedType;
  960. END;
  961. (* add reimport *)
  962. attribute.indexToType.PutType(attribute.numberTypes,type);
  963. INC(attribute.numberTypes);
  964. IF TraceImport IN Trace THEN
  965. D.Str("Type / Reimport "); D.Str(typeName); D.Str(" in "); D.Str0(importedModule.name); D.Str(":"); D.Int(tag,1-sfMod1); D.Ln;
  966. END;
  967. ELSE
  968. R.RawNum(typeAdr);
  969. type := attribute.indexToType.GetType(typeAdr);
  970. IF TraceImport IN Trace THEN
  971. D.Str("Type / Reimport "); D.Int(typeAdr,1); D.Str(" in "); D.Str0(importedModule.name); D.Str(":"); D.Int(tag,1-sfMod1); D.Ln;
  972. END;
  973. END;
  974. ELSE (* UserType = [sfInvisible] [sfSysFlag flag] UserType2 *)
  975. IF TraceImport IN Trace THEN
  976. D.Str("Type / User "); D.Str(name); D.Ln
  977. END;
  978. thisIndex := numberTypes; INC(numberTypes);
  979. IF tag = sfInvisible THEN visibility := SyntaxTree.Internal; R.RawNum(tag) END;
  980. IF tag = sfHidden THEN visibility := SyntaxTree.Hidden; R.RawNum(tag) END;
  981. IF tag = sfSysFlag THEN R.RawNum(sysflag); R.RawNum(tag) END;
  982. (* UserType2 *)
  983. typtag := tag;
  984. R.RawNum(tag);
  985. baseType := Type();
  986. R.RawString(name);
  987. CASE typtag OF
  988. | sfTypeOpenArray:
  989. IF TraceImport IN Trace THEN
  990. D.Str("Type / User / OpenArr "); D.Str(name); D.Ln
  991. END;
  992. ASSERT(baseType # NIL);
  993. arrayType := SyntaxTree.NewArrayType(Basic.invalidPosition,moduleScope,SyntaxTree.Open);
  994. arrayType.SetArrayBase(baseType);
  995. type := arrayType;
  996. R.RawNum(SYSTEM.VAL(LONGINT,flags));
  997. IF sfRealtime IN flags THEN type.SetRealtime(TRUE) END;
  998. | sfTypeStaticArray:
  999. IF TraceImport IN Trace THEN
  1000. D.Str("Type / User / Array ");
  1001. D.Int(len,1); D.Str(name); D.Ln
  1002. END;
  1003. ASSERT(baseType # NIL);
  1004. arrayType :=SyntaxTree.NewArrayType(Basic.invalidPosition,moduleScope,SyntaxTree.Static);
  1005. arrayType.SetArrayBase(baseType);
  1006. type := arrayType;
  1007. R.RawNum(SYSTEM.VAL(LONGINT,flags));
  1008. IF sfRealtime IN flags THEN type.SetRealtime(TRUE) END;
  1009. R.RawNum(len);
  1010. size := SyntaxTree.NewIntegerValue(Basic.invalidPosition,len);
  1011. size.SetType(system.longintType);
  1012. arrayType.SetLength(size);
  1013. | sfTypeOpenMathArray:
  1014. IF TraceImport IN Trace THEN
  1015. D.Str("Type / User / MathArray (open) "); D.Str(name); D.Ln
  1016. END;
  1017. ASSERT(baseType # NIL);
  1018. mathArrayType := SyntaxTree.NewMathArrayType(Basic.invalidPosition,moduleScope,SyntaxTree.Open);
  1019. mathArrayType.SetArrayBase(baseType);
  1020. type := mathArrayType;
  1021. R.RawNum(SYSTEM.VAL(LONGINT,flags));
  1022. IF sfRealtime IN flags THEN type.SetRealtime(TRUE) END;
  1023. | sfTypeTensor:
  1024. IF TraceImport IN Trace THEN
  1025. D.Str("Type / User / Tensor "); D.Str(name); D.Ln
  1026. END;
  1027. mathArrayType := SyntaxTree.NewMathArrayType(Basic.invalidPosition,moduleScope,SyntaxTree.Tensor);
  1028. mathArrayType.SetArrayBase(baseType);
  1029. type := mathArrayType;
  1030. R.RawNum(SYSTEM.VAL(LONGINT,flags));
  1031. IF sfRealtime IN flags THEN type.SetRealtime(TRUE) END;
  1032. | sfTypeStaticMathArray:
  1033. IF TraceImport IN Trace THEN
  1034. D.Str("Type / User / MathArray (Static) ");
  1035. D.Int(len,1); D.Str(name); D.Ln
  1036. END;
  1037. ASSERT(baseType # NIL);
  1038. mathArrayType :=SyntaxTree.NewMathArrayType(Basic.invalidPosition,moduleScope,SyntaxTree.Static);
  1039. mathArrayType.SetArrayBase(baseType);
  1040. type := mathArrayType;
  1041. R.RawNum(SYSTEM.VAL(LONGINT,flags));
  1042. IF sfRealtime IN flags THEN type.SetRealtime(TRUE) END;
  1043. R.RawNum(len);
  1044. size := SyntaxTree.NewIntegerValue(Basic.invalidPosition,len);
  1045. size.SetType(system.longintType);
  1046. mathArrayType.SetLength(size);
  1047. | sfTypePointer:
  1048. IF TraceImport IN Trace THEN
  1049. D.Str("Type / User / Pointer "); D.Str(name); D.Ln
  1050. END;
  1051. pointerType := SyntaxTree.NewPointerType(Basic.invalidPosition,moduleScope);
  1052. type := pointerType;
  1053. pointerType.SetPointerBase(baseType);
  1054. R.RawNum(SYSTEM.VAL(LONGINT,flags));
  1055. WITH type: SyntaxTree.PointerType DO
  1056. IF sfUnsafe IN flags THEN type.SetUnsafe(TRUE) END;
  1057. IF sfRealtime IN flags THEN type.SetRealtime(TRUE) END;
  1058. IF sfDisposable IN flags THEN type.SetDisposable(TRUE) END;
  1059. END;
  1060. | sfTypeRecord:
  1061. IF TraceImport IN Trace THEN
  1062. D.Str("Type / User / Record "); D.Str(name); D.Ln
  1063. END;
  1064. recordScope := SyntaxTree.NewRecordScope(moduleScope);
  1065. recordType := SyntaxTree.NewRecordType(Basic.invalidPosition,moduleScope,recordScope);
  1066. type := recordType;
  1067. R.RawNum(SYSTEM.VAL(LONGINT,flags));
  1068. IF sfRealtime IN flags THEN type.SetRealtime(TRUE) END;
  1069. Record(recordType,baseType);
  1070. | sfTypeProcedure:
  1071. IF TraceImport IN Trace THEN
  1072. D.Str("Type / User / Proc "); D.Str(name); D.Ln
  1073. END;
  1074. procedureScope := SyntaxTree.NewProcedureScope(NIL);
  1075. procedureType := SyntaxTree.NewProcedureType(Basic.invalidPosition,moduleScope);
  1076. procedureType.SetReturnType(baseType);
  1077. type := procedureType;
  1078. IF sysflag = sfDelegate THEN procedureType.SetDelegate(TRUE) END;
  1079. R.RawNum(SYSTEM.VAL(LONGINT,flags));
  1080. IF sfWinAPIParam IN flags THEN procedureType.SetCallingConvention(SyntaxTree.WinAPICallingConvention)
  1081. ELSIF sfCParam IN flags THEN procedureType.SetCallingConvention(SyntaxTree.CCallingConvention)
  1082. ELSIF sfDarwinCParam IN flags THEN procedureType.SetCallingConvention(SyntaxTree.DarwinCCallingConvention)
  1083. END;
  1084. IF sfRealtime IN flags THEN procedureType.SetRealtime(TRUE) END;
  1085. ParameterList(callingConvention,procedureScope,procedureType);
  1086. | sfTypeEnumeration:
  1087. IF TraceImport IN Trace THEN
  1088. D.Str("Type / User / Enumerator "); D.Str(name); D.Ln
  1089. END;
  1090. enumerationScope := SyntaxTree.NewEnumerationScope(moduleScope);
  1091. enumerationType := SyntaxTree.NewEnumerationType(Basic.invalidPosition,moduleScope,enumerationScope);
  1092. type := enumerationType;
  1093. enumerationType.SetEnumerationBase(baseType);
  1094. EnumerationList(enumerationScope);
  1095. END;
  1096. IF name # "" THEN
  1097. typeDeclaration := SyntaxTree.NewTypeDeclaration(Basic.invalidPosition,SyntaxTree.NewIdentifier(name));
  1098. typeDeclaration.SetDeclaredType(type);
  1099. type.SetTypeDeclaration(typeDeclaration);
  1100. typeDeclaration.SetAccess(visibility);
  1101. typeDeclaration.SetState(SyntaxTree.Resolved);
  1102. qualifiedType := SyntaxTree.NewQualifiedType(Basic.invalidPosition,moduleScope, SyntaxTree.NewQualifiedIdentifier(Basic.invalidPosition,SyntaxTree.invalidIdentifier,typeDeclaration.name));
  1103. qualifiedType.SetResolved(type);
  1104. type := qualifiedType;
  1105. type.SetTypeDeclaration(typeDeclaration);
  1106. module.moduleScope.AddTypeDeclaration(typeDeclaration); (* do not replace module.moduleScope by parentScope ! *)
  1107. module.moduleScope.EnterSymbol(typeDeclaration,b);
  1108. END;
  1109. allTypes.PutType(thisIndex,type);
  1110. IF TraceImport IN Trace THEN
  1111. D.Str("resolver.AddType "); D.Str(name); D.Str(" "); D.Int(thisIndex,1); D.Str("");
  1112. D.Ln
  1113. END;
  1114. END;
  1115. RETURN type;
  1116. END Type;
  1117. (*
  1118. Inline = {len:Char {c:Char}} 0X
  1119. *)
  1120. PROCEDURE Inline(scope: SyntaxTree.ProcedureScope);
  1121. VAR ch: CHAR; pos, len: LONGINT; array: SyntaxTree.BinaryCode; newcode: SyntaxTree.Code;
  1122. body: SyntaxTree.Body;
  1123. PROCEDURE Append(ch: CHAR);
  1124. BEGIN
  1125. array.Resize(pos+8);
  1126. array.SetBits(pos,8,ORD(ch));
  1127. INC(pos,8);
  1128. END Append;
  1129. BEGIN
  1130. NEW(array,128*8);
  1131. R.Char(ch);pos := 0;
  1132. REPEAT
  1133. len := ORD(ch);
  1134. WHILE len > 0 DO R.Char(ch); Append(ch); DEC(len) END;
  1135. R.Char(ch);
  1136. UNTIL ch = 0X;
  1137. body := SyntaxTree.NewBody(Basic.invalidPosition,scope);
  1138. newcode := SyntaxTree.NewCode(Basic.invalidPosition,body);
  1139. body.SetCode(newcode);
  1140. scope.SetBody(body);
  1141. newcode.SetBinaryCode(array);
  1142. END Inline;
  1143. (* Symbol = [sfObjFlag flag:RawNum] [sfReadOnly] Type name:RawString *)
  1144. PROCEDURE Symbol(parentScope: SyntaxTree.Scope; VAR type: SyntaxTree.Type; VAR name: SyntaxTree.IdentifierString; VAR visibility: SET; VAR untraced, realtime, constructor, operator, isDynamic, isFictive: BOOLEAN; VAR fictiveOffset: LONGINT);
  1145. VAR f,i: LONGINT;
  1146. BEGIN
  1147. IF TraceImport IN Trace THEN
  1148. D.Str("Symbol: --> "); D.Ln
  1149. END;
  1150. untraced := FALSE; realtime := FALSE; constructor := FALSE; isDynamic := FALSE; isFictive := FALSE;
  1151. visibility:=SyntaxTree.Public+SyntaxTree.Protected+SyntaxTree.Internal;
  1152. WHILE tag=sfObjFlag DO
  1153. R.RawNum(f);
  1154. IF f = sfFictive THEN isFictive := TRUE; untraced := TRUE; TRACE(fictiveOffset); R.RawNum(fictiveOffset);
  1155. ELSIF f = sfUntraced THEN untraced := TRUE
  1156. ELSIF f = sfRealtime THEN realtime := TRUE
  1157. ELSIF f = sfOperator THEN operator := TRUE;
  1158. ELSIF f = sfDynamic THEN isDynamic := TRUE;
  1159. ELSE D.Str("Object: unknown objflag"); D.Ln
  1160. END;
  1161. R.RawNum(tag);
  1162. END;
  1163. IF tag=sfReadOnly THEN visibility := visibility * SyntaxTree.ReadOnly; R.RawNum(tag) END;
  1164. type := Type();
  1165. R.RawString(name);
  1166. IF ~operator & (name[0] = "&") THEN
  1167. constructor := TRUE;
  1168. i := 0; REPEAT name[i] := name[i+1]; INC(i) UNTIL name[i] = 0X;
  1169. END;
  1170. IF name = "" THEN
  1171. visibility := visibility * SyntaxTree.Internal;
  1172. END;
  1173. IF TraceImport IN Trace THEN
  1174. D.Str("<-- "); D.Str(name); D.Ln
  1175. END;
  1176. END Symbol;
  1177. (*
  1178. SymbolFile =
  1179. coeOptions:RawSet
  1180. Imports
  1181. [sfSysFlag sysFlags:Number]
  1182. [sfConst {Symbol Value}]
  1183. [sfVar {Symbol}]
  1184. [sfXProcedure {Symbol ParameterList}]
  1185. [sfOperator {Symbol ParameterList [sfInline Inline]}]
  1186. [sfCProcedure {Symbol ParameterList Inline}]
  1187. [sfAlias {Type name:RawString}]
  1188. [sfType {Type}]
  1189. sfEnd
  1190. *)
  1191. PROCEDURE Module;
  1192. VAR flags: SET; untraced, realtime, constructor,operator, isDynamic, isFictive: BOOLEAN; callingConvention: LONGINT; fOffset: LONGINT;
  1193. BEGIN
  1194. R.RawSet(flags);
  1195. Imports;
  1196. R.RawNum(tag);
  1197. flags := {};
  1198. IF tag = sfSysFlag THEN
  1199. R.RawNum(SYSTEM.VAL(LONGINT, flags));
  1200. R.RawNum(tag);
  1201. END;
  1202. IF TraceImport IN Trace THEN D.Str("importing constants"); D.Ln; END;
  1203. IF tag=sfConst THEN R.RawNum(tag);
  1204. WHILE (tag < sfVar) OR (tag > sfEnd) DO
  1205. operator := FALSE;
  1206. Symbol(moduleScope,type,name, visibility,untraced,realtime,constructor,operator, isDynamic, isFictive, fOffset);
  1207. ASSERT(type # NIL);
  1208. value := Value(type);
  1209. constant := SyntaxTree.NewConstant(Basic.invalidPosition,SyntaxTree.NewIdentifier(name));
  1210. constant.SetValue(value);
  1211. constant.SetType(value.type);
  1212. constant.SetAccess(visibility);
  1213. constant.SetState(SyntaxTree.Resolved);
  1214. moduleScope.AddConstant(constant);
  1215. moduleScope.EnterSymbol(constant,b);
  1216. R.RawNum(tag)
  1217. END
  1218. END;
  1219. IF TraceImport IN Trace THEN D.Str("importing variables"); D.Ln; END;
  1220. IF tag=sfVar THEN R.RawNum(tag);
  1221. WHILE (tag < sfXProcedure) OR (tag > sfEnd) DO
  1222. operator := FALSE;
  1223. Symbol(moduleScope,type,name, visibility,untraced,realtime,constructor,operator, isDynamic,isFictive, fOffset);
  1224. ASSERT(type # NIL);
  1225. variable := SyntaxTree.NewVariable(Basic.invalidPosition,SyntaxTree.NewIdentifier(name));
  1226. variable.SetType(type);
  1227. variable.SetAccess(visibility);
  1228. variable.SetState(SyntaxTree.Resolved);
  1229. IF isFictive THEN
  1230. TRACE(fOffset);
  1231. variable.SetFictive(fOffset);
  1232. variable.SetUntraced(TRUE);
  1233. END;
  1234. moduleScope.AddVariable(variable);
  1235. moduleScope.EnterSymbol(variable,b);
  1236. R.RawNum(tag)
  1237. END
  1238. END;
  1239. IF TraceImport IN Trace THEN D.Str("importing procedures"); D.Ln; END;
  1240. IF tag=sfXProcedure THEN R.RawNum(tag);
  1241. WHILE (tag < sfOperator) OR (tag > sfEnd) DO
  1242. operator := FALSE;
  1243. Symbol(moduleScope,type,name, visibility,untraced,realtime,constructor,operator, isDynamic, isFictive, fOffset);
  1244. ASSERT(~(constructor));
  1245. procedureScope := SyntaxTree.NewProcedureScope(moduleScope);
  1246. procedureType := SyntaxTree.NewProcedureType(Basic.invalidPosition,moduleScope);
  1247. procedureType.SetReturnType(type);
  1248. procedure := SyntaxTree.NewProcedure(Basic.invalidPosition,SyntaxTree.NewIdentifier(name),procedureScope);
  1249. procedure.SetType(procedureType);
  1250. procedure.SetAccess(visibility);
  1251. ParameterList(callingConvention,procedureScope,procedureType);
  1252. procedureType.SetRealtime(realtime);
  1253. procedure.SetState(SyntaxTree.Resolved);
  1254. procedure.SetConstructor(constructor);
  1255. moduleScope.AddProcedure(procedure);
  1256. moduleScope.EnterSymbol(procedure,b);
  1257. R.RawNum(tag)
  1258. END
  1259. END;
  1260. IF TraceImport IN Trace THEN D.Str("importing operators"); D.Ln; END;
  1261. IF tag=sfOperator THEN R.RawNum(tag);
  1262. WHILE (tag < sfCProcedure) OR (tag > sfEnd) DO
  1263. operator := TRUE;
  1264. Symbol(moduleScope,type,name, visibility,untraced,realtime,constructor,operator, isDynamic, isFictive, fOffset);
  1265. ASSERT(~(constructor));
  1266. procedureScope := SyntaxTree.NewProcedureScope(moduleScope);
  1267. procedureType := SyntaxTree.NewProcedureType(Basic.invalidPosition,moduleScope);
  1268. procedureType.SetReturnType(type);
  1269. procedureType.SetRealtime(realtime);
  1270. procedure := SyntaxTree.NewOperator(Basic.invalidPosition,SyntaxTree.NewIdentifier(name),procedureScope);
  1271. procedure.SetType(procedureType);
  1272. procedure.SetAccess(visibility);
  1273. procedure(SyntaxTree.Operator).SetDynamic(isDynamic);
  1274. ParameterList(callingConvention,procedureScope,procedureType);
  1275. procedureType.SetCallingConvention(callingConvention);
  1276. procedure.SetState(SyntaxTree.Resolved);
  1277. module.moduleScope.AddProcedure(procedure);
  1278. module.moduleScope.AddOperator(procedure(SyntaxTree.Operator));
  1279. module.moduleScope.EnterSymbol(procedure,b);
  1280. R.RawNum(tag);
  1281. IF tag = sfInline THEN
  1282. Inline(procedureScope);
  1283. procedure.SetInline(TRUE);
  1284. R.RawNum(tag);
  1285. END;
  1286. END
  1287. END;
  1288. IF TraceImport IN Trace THEN D.Str("importing inline procedures"); D.Ln; END;
  1289. IF tag = sfCProcedure THEN R.RawNum(tag);
  1290. WHILE (tag < sfAlias) OR (tag > sfEnd) DO
  1291. operator := FALSE;
  1292. Symbol(moduleScope,type,name, visibility,untraced, realtime, constructor,operator, isDynamic, isFictive, fOffset);
  1293. ASSERT(~(constructor));
  1294. procedureScope := SyntaxTree.NewProcedureScope(moduleScope);
  1295. procedureType := SyntaxTree.NewProcedureType(Basic.invalidPosition,moduleScope);
  1296. procedure := SyntaxTree.NewProcedure(Basic.invalidPosition,SyntaxTree.NewIdentifier(name),procedureScope);
  1297. procedureType.SetReturnType(type);
  1298. procedure.SetInline(TRUE);
  1299. procedure.SetType(procedureType);
  1300. procedure.SetAccess(visibility);
  1301. ParameterList(callingConvention,procedureScope,procedureType);
  1302. procedure.SetState(SyntaxTree.Resolved);
  1303. module.moduleScope.AddProcedure(procedure);
  1304. module.moduleScope.EnterSymbol(procedure,b);
  1305. Inline(procedureScope);
  1306. R.RawNum(tag);
  1307. END
  1308. END;
  1309. IF TraceImport IN Trace THEN D.Str("importing type declaration aliases"); D.Ln; END;
  1310. IF tag=sfAlias THEN R.RawNum(tag);
  1311. WHILE (tag < sfType) OR (tag > sfEnd) DO
  1312. type := Type();
  1313. R.RawString(name);
  1314. IF TraceImport IN Trace THEN D.Str("alias:"); D.Str(name); D.Ln END;
  1315. typeDeclaration := SyntaxTree.NewTypeDeclaration(Basic.invalidPosition,SyntaxTree.NewIdentifier(name));
  1316. typeDeclaration.SetDeclaredType(type);
  1317. visibility := SyntaxTree.Public+SyntaxTree.Protected+SyntaxTree.Internal;
  1318. typeDeclaration.SetAccess(visibility);
  1319. typeDeclaration.SetState(SyntaxTree.Resolved);
  1320. IF ~(type IS SyntaxTree.BasicType) THEN
  1321. type.SetTypeDeclaration(typeDeclaration);
  1322. END;
  1323. module.moduleScope.AddTypeDeclaration(typeDeclaration);
  1324. module.moduleScope.EnterSymbol(typeDeclaration,b);
  1325. R.RawNum(tag)
  1326. END
  1327. END;
  1328. IF TraceImport IN Trace THEN D.Str("importing type declaration"); D.Ln; END;
  1329. IF tag=sfType THEN
  1330. R.RawNum(tag);
  1331. WHILE tag # sfEnd DO
  1332. type := Type();
  1333. R.RawNum(tag)
  1334. END
  1335. END;
  1336. END Module;
  1337. PROCEDURE InitBasic(type: SyntaxTree.Type; tag: LONGINT);
  1338. BEGIN
  1339. predefType[tag] := type;
  1340. END InitBasic;
  1341. PROCEDURE Init;
  1342. BEGIN
  1343. (*Built-In types*)
  1344. InitBasic(system.booleanType,sfTypeBoolean);
  1345. InitBasic(system.characterType,sfTypeChar8);
  1346. InitBasic(Global.Character16,sfTypeChar16);
  1347. InitBasic(Global.Character32,sfTypeChar32);
  1348. InitBasic(system.shortintType, sfTypeShortint);
  1349. InitBasic(system.integerType, sfTypeInteger);
  1350. InitBasic(system.longintType, sfTypeLongint);
  1351. InitBasic(system.hugeintType, sfTypeHugeint);
  1352. InitBasic(Global.Unsigned8, sfTypeUnsigned8);
  1353. InitBasic(Global.Unsigned16, sfTypeUnsigned16);
  1354. InitBasic(Global.Unsigned32, sfTypeUnsigned32);
  1355. InitBasic(Global.Unsigned64, sfTypeUnsigned64);
  1356. InitBasic(Global.Float32, sfTypeReal);
  1357. InitBasic(Global.Float64, sfTypeLongreal);
  1358. InitBasic(system.setType, sfTypeSet);
  1359. InitBasic(system.anyType, sfTypeAny);
  1360. InitBasic(system.objectType, sfTypeObject);
  1361. InitBasic(system.nilType, sfTypeNilType);
  1362. InitBasic(NIL, sfTypeNoType);
  1363. InitBasic(system.byteType, sfTypeByte);
  1364. InitBasic(system.sizeType, sfTypeSize);
  1365. InitBasic(system.addressType, sfTypeAddress);
  1366. END Init;
  1367. BEGIN
  1368. Init;
  1369. i := 0; numberTypes := 0; numberReimports := 0;
  1370. COPY(moduleName,fileName);
  1371. NEW(allTypes,32); NEW(indexToAttribute,32);
  1372. ASSERT(fileName # "SYSTEM");
  1373. IF ~OpenSymFile(fileName, path, extension, R, version) THEN (*! reintroduce flexible extension *)
  1374. RETURN NIL
  1375. END;
  1376. IF TraceImport IN Trace THEN
  1377. D.Str("BINARY SYMBOL FILE IMPORT "); D.Str(moduleName); D.Ln;
  1378. END;
  1379. (* as the context is not encoded in the symbol file, we have to deduce it from the filename, this is ugly but necessary
  1380. to keep consistency with old compiler
  1381. *)
  1382. Global.ContextFromName(moduleName,moduleIdentifier,contextIdentifier);
  1383. moduleScope := SyntaxTree.NewModuleScope();
  1384. module:= SyntaxTree.NewModule(fileName,Basic.invalidPosition,moduleIdentifier,moduleScope,Scanner.Uppercase);
  1385. module.SetContext(contextIdentifier);
  1386. IF importCache = NIL THEN importCache := SyntaxTree.NewModuleScope(); END;
  1387. Module;
  1388. stamp := Kernel.GetTicks();
  1389. NEW(resolver,system,SELF,importCache);
  1390. resolver.Resolve(module,allTypes);
  1391. module.SetState(SyntaxTree.Resolved);
  1392. IF TraceImport IN Trace THEN
  1393. D.Str("BINARY SYMBOL FILE IMPORT DONE "); D.Str(moduleName); D.Ln;
  1394. END;
  1395. (* if import error then module := NIL *)
  1396. RETURN module
  1397. END Import;
  1398. PROCEDURE Export(module: SyntaxTree.Module; importCache: SyntaxTree.ModuleScope): BOOLEAN;
  1399. VAR w: Files.Writer; lookup: TypeToIndex; indexToAttribute: IndexToAttribute; numberType: LONGINT; flags: SET;
  1400. (* Imports = {moduleName:RawString} 0X *)
  1401. PROCEDURE Imports(import: SyntaxTree.Import);
  1402. VAR name: SyntaxTree.IdentifierString;
  1403. BEGIN
  1404. WHILE import # NIL DO
  1405. IF ~Global.IsSystemModule(import.module) THEN
  1406. Global.ModuleFileName(import.module.name,import.module.context,name);
  1407. (*! maybe the context and module name should be stored as different names ? *)
  1408. IF TraceExport IN Trace THEN
  1409. D.Str("import: "); D.Str(name); D.Ln;
  1410. END;
  1411. w.RawString(name);
  1412. END;
  1413. import := import.nextImport;
  1414. END;
  1415. w.RawNum(0); (* end of imports *)
  1416. END Imports;
  1417. (* Value = [RawNum | RawHInt | RawReal | RawLReal | RawString] *)
  1418. PROCEDURE Value(v: SyntaxTree.Value);
  1419. VAR type: SyntaxTree.Type;
  1420. BEGIN
  1421. type := v.type.resolved;
  1422. IF type IS SyntaxTree.BooleanType THEN w.RawNum(SYSTEM.VAL(SHORTINT,v(SyntaxTree.BooleanValue).value))
  1423. ELSIF type IS SyntaxTree.CharacterType THEN w.RawNum(ORD(v(SyntaxTree.CharacterValue).value));
  1424. (*
  1425. ELSIF type = Global.Char16 THEN w.RawNum(ORD(v(SyntaxTree.CharacterValue).value));
  1426. ELSIF type = Global.Char32 THEN w.RawNum(ORD(v(SyntaxTree.CharacterValue).value));
  1427. *)
  1428. ELSIF (type IS SyntaxTree.IntegerType) & (type.sizeInBits = 64) THEN w.RawHInt(v(SyntaxTree.IntegerValue).hvalue);
  1429. ELSIF (type IS SyntaxTree.IntegerType) & (type.sizeInBits = 32) & ~type(SyntaxTree.IntegerType).signed THEN w.RawHInt(v(SyntaxTree.IntegerValue).hvalue);
  1430. ELSIF (type IS SyntaxTree.IntegerType) & (type.sizeInBits <= 32) THEN w.RawNum(v(SyntaxTree.IntegerValue).value);
  1431. ELSIF type IS SyntaxTree.SetType THEN w.RawNum(SYSTEM.VAL(LONGINT,v(SyntaxTree.SetValue).value));
  1432. ELSIF type IS SyntaxTree.FloatType THEN
  1433. IF type.sizeInBits = 32 THEN w.RawReal(SHORT(v(SyntaxTree.RealValue).value));
  1434. ELSE w.RawLReal(v(SyntaxTree.RealValue).value);
  1435. END;
  1436. ELSIF type IS SyntaxTree.StringType THEN w.RawLInt(v(SyntaxTree.StringValue).length); w.RawString(v(SyntaxTree.StringValue).value^);
  1437. ELSIF type IS SyntaxTree.NilType THEN
  1438. ELSIF type IS SyntaxTree.ByteType THEN HALT(100)
  1439. ELSIF type IS SyntaxTree.EnumerationType THEN w.RawNum(v(SyntaxTree.EnumerationValue).value);
  1440. ELSE HALT(200);
  1441. END;
  1442. END Value;
  1443. (*
  1444. Record =
  1445. mode:RawNum priority:Char {variable:Symbol}
  1446. [sfTProcedure {Symbol [name:RawString] ParameterList [sfInline Inline]} ]
  1447. sfEnd
  1448. *)
  1449. PROCEDURE Record(record: SyntaxTree.RecordType);
  1450. VAR scope: SyntaxTree.RecordScope; variable: SyntaxTree.Variable; procedure: SyntaxTree.Procedure; name: SyntaxTree.IdentifierString; flags,mode: SET;
  1451. procedureType: SyntaxTree.ProcedureType; body: SyntaxTree.Body; first: BOOLEAN;
  1452. BEGIN
  1453. scope := record.recordScope;
  1454. IF record.recordScope.bodyProcedure # NIL THEN
  1455. body := record.recordScope.bodyProcedure.procedureScope.body;
  1456. IF body.isActive THEN INCL(mode,sfActive) END;
  1457. IF body.isSafe THEN INCL(mode,sfSafe) END;
  1458. END;
  1459. IF record.IsProtected() THEN INCL(mode,sfProtected) END;
  1460. IF record.pointerType # NIL THEN INCL(mode,sfClass) END;
  1461. w.RawNum(SYSTEM.VAL(LONGINT,mode));
  1462. w.Char(0X); (*! record priority *)
  1463. variable := scope.firstVariable;
  1464. WHILE variable # NIL DO
  1465. ASSERT(variable.type # NIL);
  1466. Symbol(variable.type,variable.name,variable.access,variable.untraced,FALSE, FALSE, FALSE, FALSE, variable.fictive, variable.fictiveOffset);
  1467. variable := variable.nextVariable;
  1468. END;
  1469. procedure := scope.firstProcedure;
  1470. IF procedure # NIL THEN
  1471. w.RawNum(sfTProcedure);
  1472. WHILE procedure # NIL DO
  1473. procedureType := procedure.type(SyntaxTree.ProcedureType);
  1474. IF (procedure.access * SyntaxTree.Internal = procedure.access) THEN (* not exported method *)
  1475. Symbol(procedureType.returnType,procedure.name,procedure.access,FALSE, procedureType.isRealtime,procedure.isConstructor,procedure IS SyntaxTree.Operator, FALSE, FALSE, 0);
  1476. procedure.GetName(name);
  1477. w.RawString(name);
  1478. ELSE (* exported method *)
  1479. Symbol(procedureType.returnType,procedure.name,SyntaxTree.Public (*! for compatiblity should be procedure.access *),
  1480. FALSE, procedureType.isRealtime,procedure.isConstructor, procedure IS SyntaxTree.Operator, FALSE, FALSE, 0
  1481. );
  1482. END;
  1483. ParameterList(procedure.type(SyntaxTree.ProcedureType));
  1484. (*! inline *)
  1485. procedure := procedure.nextProcedure;
  1486. END;
  1487. END;
  1488. w.RawNum(sfEnd);
  1489. END Record;
  1490. (* returns the index of module importedModule in the list of module module *)
  1491. PROCEDURE ModuleIndex(module: SyntaxTree.Module; importedModule: SyntaxTree.Module): LONGINT;
  1492. VAR import: SyntaxTree.Import; index: LONGINT;
  1493. BEGIN import := module.moduleScope.firstImport;
  1494. index := 0;
  1495. WHILE (import # NIL) & (import.module # importedModule) DO
  1496. IF (* (import.direct) & *) ~Global.IsSystemModule(import.module) THEN INC(index) END;
  1497. import := import.nextImport;
  1498. END;
  1499. ASSERT(import # NIL);
  1500. RETURN index;
  1501. END ModuleIndex;
  1502. (*
  1503. Type =
  1504. TypeReference
  1505. |BasicType
  1506. |ImportedType
  1507. |UserType.
  1508. TypeReference = number:RawNum(<0)
  1509. BasicType = sfTypeBoolean | .. | sfLastType.
  1510. ImportedType = ModuleNumber (structName:RawString | 0X typeIndex:RawNum)
  1511. ModuleNumber = sfMod1 | .. | sfModOther-1 | sfModOther moduleNumber:RawNum
  1512. UserType = [sfInvisible] [sfSysFlag sysFlag:RawNum] UserType2
  1513. UserType2=
  1514. sfTypeOpenArray baseType:Type name:RawString flags:RawNum
  1515. |sfTypeStaticArray baseType:Type name:RawString flags:RawNum length:RawNum
  1516. |sfOpenMathArray baseType:Type name:RawString
  1517. |sfStaticMathArray baseType:Type name:RawString length:RawNum
  1518. |sfTypeTensor baseType:Type name:RawString
  1519. |sfTypePointer baseType:Type name:RawString flags:RawNum
  1520. |sfTypeRecord baseType:Type name:RawString flags:RawNum Record
  1521. |sfTypeProcedure baseType:Type name:RawString flags:RawNum ParameterList
  1522. |sfTypeEnumeration enumerationBase:Type name:RawString
  1523. *)
  1524. PROCEDURE Type(type: SyntaxTree.Type);
  1525. VAR typeIndex,moduleIndex: LONGINT; name:SyntaxTree.IdentifierString; importedModule: SyntaxTree.Module; attribute: Attribute;
  1526. baseType: SyntaxTree.Type; typeDeclaration : SyntaxTree.TypeDeclaration; flags: SET; size: LONGINT;
  1527. BEGIN
  1528. IF type = NIL THEN
  1529. IF TraceExport IN Trace THEN
  1530. D.Str("Type / Basic / NIL "); D.Ln
  1531. END;
  1532. w.RawNum(sfTypeNoType); RETURN
  1533. END;
  1534. type := type.resolved;
  1535. typeDeclaration := type.typeDeclaration;
  1536. IF (typeDeclaration # NIL) & (typeDeclaration.declaredType.resolved # type) THEN typeDeclaration := NIL END;
  1537. size := type.sizeInBits;
  1538. IF type IS SyntaxTree.BasicType THEN (* BasicType *)
  1539. IF type IS SyntaxTree.BooleanType THEN w.RawNum(sfTypeBoolean);
  1540. IF TraceExport IN Trace THEN
  1541. D.Str("Type / Basic / Boolean "); D.Ln
  1542. END;
  1543. ELSIF type IS SyntaxTree.CharacterType THEN
  1544. IF size = 8 THEN
  1545. w.RawNum(sfTypeChar8);
  1546. IF TraceExport IN Trace THEN
  1547. D.Str("Type / Basic / Char8"); D.Ln
  1548. END;
  1549. ELSIF size = 16 THEN
  1550. w.RawNum(sfTypeChar16);
  1551. IF TraceExport IN Trace THEN
  1552. D.Str("Type / Basic / Char16"); D.Ln
  1553. END;
  1554. ELSIF size = 32 THEN
  1555. w.RawNum(sfTypeChar32);
  1556. IF TraceExport IN Trace THEN
  1557. D.Str("Type / Basic / Char32"); D.Ln
  1558. END;
  1559. END
  1560. ELSIF type IS SyntaxTree.IntegerType THEN
  1561. IF type(SyntaxTree.IntegerType).signed THEN
  1562. IF size = 8 THEN
  1563. w.RawNum(sfTypeShortint);
  1564. IF TraceExport IN Trace THEN
  1565. D.Str("Type / Basic / Shortint"); D.Ln
  1566. END;
  1567. ELSIF size = 16 THEN
  1568. w.RawNum(sfTypeInteger);
  1569. IF TraceExport IN Trace THEN
  1570. D.Str("Type / Basic / Integer"); D.Ln
  1571. END;
  1572. ELSIF size = 32 THEN
  1573. w.RawNum(sfTypeLongint);
  1574. IF TraceExport IN Trace THEN
  1575. D.Str("Type / Basic / Longint"); D.Ln
  1576. END;
  1577. ELSIF size = 64 THEN w.RawNum(sfTypeHugeint);
  1578. IF TraceExport IN Trace THEN
  1579. D.Str("Type / Basic / Hugeint"); D.Ln
  1580. END;
  1581. END;
  1582. ELSE
  1583. IF size = 8 THEN
  1584. w.RawNum(sfTypeUnsigned8);
  1585. IF TraceExport IN Trace THEN
  1586. D.Str("Type / Basic / Unsigned8"); D.Ln
  1587. END;
  1588. ELSIF size = 16 THEN
  1589. w.RawNum(sfTypeUnsigned16);
  1590. IF TraceExport IN Trace THEN
  1591. D.Str("Type / Basic / Unsigned16"); D.Ln
  1592. END;
  1593. ELSIF size = 32 THEN
  1594. w.RawNum(sfTypeUnsigned32);
  1595. IF TraceExport IN Trace THEN
  1596. D.Str("Type / Basic / Unsigned32"); D.Ln
  1597. END;
  1598. ELSIF size = 64 THEN w.RawNum(sfTypeUnsigned64);
  1599. IF TraceExport IN Trace THEN
  1600. D.Str("Type / Basic / Unsigned64"); D.Ln
  1601. END;
  1602. END;
  1603. END;
  1604. ELSIF type IS SyntaxTree.FloatType THEN
  1605. IF size = 32 THEN
  1606. w.RawNum(sfTypeReal);
  1607. IF TraceExport IN Trace THEN
  1608. D.Str("Type / Basic / Real"); D.Ln
  1609. END;
  1610. ELSIF size = 64 THEN
  1611. w.RawNum(sfTypeLongreal);
  1612. IF TraceExport IN Trace THEN
  1613. D.Str("Type / Basic / Longreal"); D.Ln
  1614. END;
  1615. END;
  1616. ELSIF type IS SyntaxTree.ComplexType THEN
  1617. IF size = 64 THEN
  1618. w.RawNum(sfTypeComplex);
  1619. IF TraceExport IN Trace THEN
  1620. D.Str("Type / Basic / Complex"); D.Ln
  1621. END;
  1622. ELSIF size = 128 THEN
  1623. w.RawNum(sfTypeLongcomplex);
  1624. IF TraceExport IN Trace THEN
  1625. D.Str("Type / Basic / Longcomplex"); D.Ln
  1626. END;
  1627. END;
  1628. ELSIF type IS SyntaxTree.SetType THEN
  1629. w.RawNum(sfTypeSet);
  1630. IF TraceExport IN Trace THEN
  1631. D.Str("Type / Basic / Set"); D.Ln
  1632. END;
  1633. ELSIF type IS SyntaxTree.NilType THEN w.RawNum(sfTypeNilType);
  1634. IF TraceExport IN Trace THEN
  1635. D.Str("Type / Basic / NilType"); D.Ln
  1636. END;
  1637. ELSIF type IS SyntaxTree.AnyType THEN w.RawNum(sfTypeAny);
  1638. IF TraceExport IN Trace THEN
  1639. D.Str("Type / Basic / Any"); D.Ln
  1640. END;
  1641. ELSIF type IS SyntaxTree.ObjectType THEN
  1642. w.RawNum(sfTypeObject);
  1643. IF TraceExport IN Trace THEN
  1644. D.Str("Type / Basic / Object"); D.Ln
  1645. END;
  1646. ELSIF type IS SyntaxTree.ByteType THEN
  1647. w.RawNum(sfTypeByte);
  1648. IF TraceExport IN Trace THEN
  1649. D.Str("Type / Basic / Byte"); D.Ln
  1650. END;
  1651. ELSIF type IS SyntaxTree.RangeType THEN w.RawNum(sfTypeRange);
  1652. IF TraceExport IN Trace THEN
  1653. D.Str("Type / Basic / Range"); D.Ln
  1654. END;
  1655. ELSIF type IS SyntaxTree.AddressType THEN w.RawNum(sfTypeAddress) (*! compatibility with PACO *)
  1656. ELSIF type IS SyntaxTree.SizeType THEN w.RawNum(sfTypeSize)
  1657. ELSE HALT(100)
  1658. END;
  1659. ELSIF type IS SyntaxTree.StringType THEN (* special case BasicType : StringType *)
  1660. IF TraceExport IN Trace THEN
  1661. D.Str("Type / String "); D.Ln
  1662. END;
  1663. w.RawNum(sfTypeString); (*! string length should be written here also *)
  1664. ELSIF (typeDeclaration # NIL) & (typeDeclaration.scope # NIL) & (typeDeclaration.scope.ownerModule # module) THEN (* ImportedType *)
  1665. (* imported, reexport:
  1666. ImportedType = ModuleNumber (structName:RawString | 0X typeIndex:RawNum)
  1667. ModuleNumber = sfMod1 | .. | sfModOther-1 | sfModOther moduleNumber:RawNum
  1668. *)
  1669. typeDeclaration.GetName(name);
  1670. importedModule := typeDeclaration.scope.ownerModule;
  1671. moduleIndex := ModuleIndex(module,importedModule);
  1672. ASSERT(moduleIndex >= 0);
  1673. IF moduleIndex >= sfModOther - sfMod1 THEN w.RawNum(sfModOther); w.RawNum(moduleIndex)
  1674. ELSE w.RawNum(sfMod1 + moduleIndex)
  1675. END;
  1676. attribute := indexToAttribute.GetAttribute(moduleIndex);
  1677. typeIndex := attribute.typeToIndex.GetIndex(type);
  1678. IF TraceExport IN Trace THEN
  1679. D.Str("Type / Reexport "); D.Str(name); D.Str(":"); D.Int(typeIndex,1); D.String(" in "); D.Str0(importedModule.name); D.String(":"); D.Int(moduleIndex,1);D.Ln
  1680. END;
  1681. IF typeIndex = Undef THEN (* not yet written import: structName:RawString *)
  1682. type.typeDeclaration.GetName(name);
  1683. w.RawString(name);
  1684. attribute.typeToIndex.PutIndex(type,attribute.numberTypes); INC(attribute.numberTypes);
  1685. ELSE (* previously written import: 0X typeIndex:RawNum *)
  1686. w.Char(0X); w.RawNum(typeIndex);
  1687. END;
  1688. ELSE
  1689. IF TraceExport IN Trace THEN
  1690. D.Str("Type / User "); D.Ln
  1691. END;
  1692. typeIndex := lookup.GetIndex(type);
  1693. IF typeIndex # Undef THEN (* already written: TypeReference = number:RawNum (<0)*)
  1694. IF TraceExport IN Trace THEN
  1695. D.Str("Type / User / AlreadyWritten "); D.Ln
  1696. END;
  1697. w.RawNum(-typeIndex)
  1698. ELSE (* UserType *)
  1699. IF TraceExport IN Trace THEN D.Str("Type / UserType "); D.Ln END;
  1700. lookup.PutIndex(type,numberType); INC(numberType);
  1701. name:="";
  1702. IF typeDeclaration#NIL THEN typeDeclaration.GetName(name);
  1703. IF typeDeclaration.access = SyntaxTree.Hidden THEN
  1704. w.RawNum(sfHidden);
  1705. ELSIF typeDeclaration.access* SyntaxTree.Public={} THEN
  1706. w.RawNum(sfInvisible);
  1707. END;
  1708. END;
  1709. flags := {};
  1710. IF type IS SyntaxTree.RecordType THEN
  1711. IF TraceExport IN Trace THEN D.Str("Type / UserType / RecordType "); D.Str(name); D.Ln END;
  1712. WITH type: SyntaxTree.RecordType DO
  1713. w.RawNum(sfTypeRecord);
  1714. baseType := type.baseType;
  1715. Type(baseType);
  1716. w.RawString(name);
  1717. IF type.isRealtime THEN INCL(flags,sfRealtime) END;
  1718. w.RawNum(SYSTEM.VAL(LONGINT,flags));
  1719. Record(type)
  1720. END
  1721. ELSIF type IS SyntaxTree.PointerType THEN
  1722. IF TraceExport IN Trace THEN D.Str("Type / UserType / PointerType "); D.Str(name); D.Ln END;
  1723. w.RawNum(sfTypePointer);
  1724. Type(type(SyntaxTree.PointerType).pointerBase);
  1725. w.RawString(name);
  1726. WITH type: SyntaxTree.PointerType DO
  1727. IF type.isUnsafe THEN INCL(flags,sfUnsafe) END;
  1728. IF type.isRealtime THEN INCL(flags,sfRealtime) END;
  1729. IF type.isDisposable THEN INCL(flags,sfDisposable) END;
  1730. END;
  1731. w.RawNum(SYSTEM.VAL(LONGINT,flags));
  1732. ELSIF type IS SyntaxTree.ArrayType THEN
  1733. IF TraceExport IN Trace THEN D.Str("Type / UserType / ArrayType "); D.Str(name); D.Ln END;
  1734. WITH type: SyntaxTree.ArrayType DO
  1735. IF type.form = SyntaxTree.Open THEN
  1736. w.RawNum(sfTypeOpenArray)
  1737. ELSIF type.form = SyntaxTree.Static THEN
  1738. w.RawNum(sfTypeStaticArray)
  1739. ELSE HALT(100)
  1740. END;
  1741. Type(type.arrayBase);
  1742. w.RawString(name);
  1743. IF type.isRealtime THEN INCL(flags,sfRealtime) END;
  1744. w.RawNum(SYSTEM.VAL(LONGINT,flags));
  1745. IF type.form = SyntaxTree.Static THEN
  1746. w.RawNum(type.staticLength);
  1747. END;
  1748. END;
  1749. ELSIF type IS SyntaxTree.MathArrayType THEN
  1750. IF TraceExport IN Trace THEN D.Str("Type / UserType / MathArrayType "); D.Str(name); D.Ln END;
  1751. WITH type: SyntaxTree.MathArrayType DO
  1752. IF type.form = SyntaxTree.Open THEN
  1753. w.RawNum(sfTypeOpenMathArray)
  1754. ELSIF type.form = SyntaxTree.Static THEN
  1755. w.RawNum(sfTypeStaticMathArray)
  1756. ELSIF type.form = SyntaxTree.Tensor THEN
  1757. w.RawNum(sfTypeTensor)
  1758. ELSE HALT(100)
  1759. END;
  1760. Type(type.arrayBase);
  1761. w.RawString(name);
  1762. IF type.isRealtime THEN INCL(flags,sfRealtime) END;
  1763. w.RawNum(SYSTEM.VAL(LONGINT,flags));
  1764. IF type.form = SyntaxTree.Static THEN
  1765. w.RawNum(type.staticLength);
  1766. END;
  1767. END;
  1768. ELSIF type IS SyntaxTree.ProcedureType THEN
  1769. IF TraceExport IN Trace THEN D.Str("Type / UserType / ProcedureType"); D.Str(name); D.Ln END;
  1770. WITH type: SyntaxTree.ProcedureType DO
  1771. IF type.isDelegate THEN
  1772. w.RawNum(sfSysFlag); w.RawNum(sfDelegate);
  1773. END;
  1774. w.RawNum(sfTypeProcedure);
  1775. Type(type.returnType);
  1776. w.RawString(name);
  1777. IF type.callingConvention = SyntaxTree.WinAPICallingConvention THEN
  1778. INCL(flags,sfWinAPIParam);
  1779. ELSIF type.callingConvention = SyntaxTree.CCallingConvention THEN
  1780. INCL(flags,sfCParam);
  1781. ELSIF type.callingConvention = SyntaxTree.DarwinCCallingConvention THEN
  1782. INCL(flags,sfDarwinCParam);
  1783. END;
  1784. IF type.isRealtime THEN
  1785. INCL(flags,sfRealtime)
  1786. END;
  1787. w.RawNum(SYSTEM.VAL(LONGINT,flags));
  1788. ParameterList(type);
  1789. END;
  1790. ELSIF type IS SyntaxTree.EnumerationType THEN
  1791. IF TraceExport IN Trace THEN D.Str("Type / UserType / EnumerationType"); D.Str(name); D.Ln END;
  1792. WITH type: SyntaxTree.EnumerationType DO
  1793. w.RawNum(sfTypeEnumeration);
  1794. Type(type.enumerationBase);
  1795. w.RawString(name);
  1796. EnumerationList(type.enumerationScope);
  1797. END;
  1798. ELSE HALT(200)
  1799. END;
  1800. END;
  1801. END;
  1802. END Type;
  1803. (*
  1804. EnumerationList = {name:RawString} 0X;
  1805. *)
  1806. PROCEDURE EnumerationList(enumerationScope: SyntaxTree.EnumerationScope);
  1807. VAR name: SyntaxTree.IdentifierString; enumerator: SyntaxTree.Constant;
  1808. BEGIN
  1809. enumerator := enumerationScope.firstConstant;
  1810. WHILE enumerator # NIL DO
  1811. enumerator.GetName(name);
  1812. IF enumerator.access * SyntaxTree.Public = {} THEN
  1813. w.RawString("@");
  1814. ELSE
  1815. w.RawString(name);
  1816. END;
  1817. Value(enumerator.value.resolved);
  1818. enumerator := enumerator.nextConstant;
  1819. END;
  1820. w.RawString("");
  1821. END EnumerationList;
  1822. (* ParameterList =
  1823. { [sfObjFlag sfWinAPIParam | sfObjFlag sfCParam | sfObjFlag sfDarwinCParam] [sfVar] [sfReadOnly] Type name:RawString } sfEnd
  1824. *)
  1825. PROCEDURE ParameterList(procedureType: SyntaxTree.ProcedureType);
  1826. VAR flags: SET; name: SyntaxTree.IdentifierString;
  1827. PROCEDURE Parameters(parameter: SyntaxTree.Parameter; reverse: BOOLEAN);
  1828. VAR procedureType: SyntaxTree.ProcedureType;
  1829. BEGIN
  1830. WHILE parameter # NIL DO
  1831. (*! the calling convention should not be expressed via the parameters (compatiblity with old compiler) *)
  1832. procedureType := parameter.ownerType(SyntaxTree.ProcedureType);
  1833. IF procedureType.callingConvention = SyntaxTree.WinAPICallingConvention THEN
  1834. w.RawNum(sfObjFlag); w.RawNum(sfWinAPIParam);
  1835. ELSIF procedureType.callingConvention = SyntaxTree.CCallingConvention THEN
  1836. w.RawNum(sfObjFlag); w.RawNum(sfCParam);
  1837. ELSIF procedureType.callingConvention = SyntaxTree.DarwinCCallingConvention THEN
  1838. w.RawNum(sfObjFlag); w.RawNum(sfDarwinCParam);
  1839. END;
  1840. IF parameter.kind = SyntaxTree.VarParameter THEN
  1841. w.RawNum(sfVar)
  1842. ELSIF parameter.kind = SyntaxTree.ConstParameter THEN
  1843. IF (parameter.type.resolved IS SyntaxTree.ArrayType) OR (parameter.type.resolved IS SyntaxTree.RecordType) THEN
  1844. w.RawNum(sfVar);
  1845. END; (* cf. FingerPrint.FPSignature *)
  1846. w.RawNum(sfReadOnly);
  1847. END;
  1848. Type(parameter.type);
  1849. parameter.GetName(name);
  1850. w.RawString(name);
  1851. IF reverse THEN
  1852. parameter := parameter.prevParameter
  1853. ELSE
  1854. parameter := parameter.nextParameter
  1855. END;
  1856. END;
  1857. END Parameters;
  1858. BEGIN
  1859. IF procedureType.callingConvention # SyntaxTree.OberonCallingConvention THEN
  1860. (*! if a procedure has a return type, then it has a return parameter (new)
  1861. ASSERT(procedureType.returnParameter = NIL);
  1862. *)
  1863. Parameters(procedureType.lastParameter,TRUE);
  1864. ELSE
  1865. Parameters(procedureType.firstParameter,FALSE);
  1866. END;
  1867. w.RawNum(sfEnd);
  1868. END ParameterList;
  1869. PROCEDURE Inline(procedureScope: SyntaxTree.ProcedureScope);
  1870. VAR len,count,pos: LONGINT; code: SyntaxTree.Code; ch: CHAR;
  1871. BEGIN
  1872. code := procedureScope.body.code;
  1873. IF code.inlineCode # NIL THEN
  1874. len := code.inlineCode.GetSize() DIV 8;
  1875. ELSE
  1876. len := 0
  1877. END;
  1878. count := 0; pos := 0;
  1879. IF len = 0 THEN
  1880. w.Char(0X);
  1881. ELSE
  1882. WHILE pos < len DO
  1883. IF count = 0 THEN
  1884. count := 255;
  1885. IF len < 255 THEN count := len END;
  1886. w.Char(CHR(count))
  1887. END;
  1888. ch := CHR(code.inlineCode.GetBits(pos*8,8));
  1889. w.Char(ch);
  1890. INC(pos); DEC(count)
  1891. END;
  1892. END;
  1893. w.Char(0X);
  1894. END Inline;
  1895. (* Symbol =
  1896. [sfObjFlag flag:RawNum] [sfReadOnly] Type Name
  1897. *)
  1898. PROCEDURE Symbol(type: SyntaxTree.Type; name: SyntaxTree.Identifier; visibility: SET;untraced, realtime, constructor, operator, isDynamic, isFictive: BOOLEAN; fOffset: LONGINT);
  1899. VAR string,string2: SyntaxTree.IdentifierString;
  1900. BEGIN
  1901. IF TraceExport IN Trace THEN
  1902. Basic.GetString(name,string);
  1903. D.Str("Symbol "); D.Str(string); D.Ln;
  1904. END;
  1905. IF isFictive THEN w.RawNum(sfObjFlag); w.RawNum(sfFictive); TRACE(fOffset); w.RawNum(fOffset);
  1906. ELSIF untraced THEN w.RawNum(sfObjFlag); w.RawNum(sfUntraced)
  1907. ELSIF realtime THEN w.RawNum(sfObjFlag); w.RawNum(sfRealtime)
  1908. END;
  1909. IF operator THEN w.RawNum(sfObjFlag); w.RawNum(sfOperator) END;
  1910. IF isDynamic THEN w.RawNum(sfObjFlag); w.RawNum(sfDynamic) END;
  1911. IF (SyntaxTree.PublicRead IN visibility) & ~(SyntaxTree.PublicWrite IN visibility) THEN
  1912. w.RawNum(sfReadOnly);
  1913. END;
  1914. Type(type);
  1915. IF visibility * SyntaxTree.Internal = visibility THEN
  1916. string2 := "";
  1917. IF constructor THEN string2 := "&" END;
  1918. ELSE Basic.GetString(name,string);
  1919. IF constructor THEN
  1920. Basic.Concat(string2,"&",string,"");
  1921. ELSE
  1922. string2 := string
  1923. END;
  1924. END;
  1925. w.RawString(string2);
  1926. END Symbol;
  1927. (*
  1928. SymbolFile =
  1929. flags:RawSet
  1930. Imports
  1931. [sfSysFlag flags:Number]
  1932. [sfConst {Symbol Value}]
  1933. [sfVar {Symbol}]
  1934. [sfXProcedure {Symbol ParameterList}]
  1935. [sfOperator {Symbol ParameterList [sfInline Inline]}]
  1936. [sfCProcedure {Symbol ParameterList Inline}]
  1937. [sfAlias {declaredType:Type Name}]
  1938. [sfType {declaredType:Type}]
  1939. sfEnd
  1940. *)
  1941. PROCEDURE Module(module: SyntaxTree.Module);
  1942. VAR constant: SyntaxTree.Constant; name: SyntaxTree.IdentifierString; first: BOOLEAN;
  1943. variable: SyntaxTree.Variable; typeDeclaration: SyntaxTree.TypeDeclaration; procedure: SyntaxTree.Procedure;
  1944. procedureType: SyntaxTree.ProcedureType;
  1945. BEGIN
  1946. IF TraceExport IN Trace THEN
  1947. module.GetName(name);
  1948. D.Str("BINARY SYMBOL FILE EXPORT "); D.Str(name); D.Ln;
  1949. END;
  1950. w.RawSet({}); (* compilation flags *)
  1951. (* overloading flags omitted *)
  1952. (* import section: write names of imported modules *)
  1953. Imports(module.moduleScope.firstImport);
  1954. (* constants *)
  1955. IF TraceExport IN Trace THEN
  1956. D.Str("exporting constants "); D.Ln;
  1957. END;
  1958. first :=TRUE;
  1959. constant := module.moduleScope.firstConstant;
  1960. WHILE constant # NIL DO
  1961. IF constant.access * SyntaxTree.Public # {} THEN
  1962. IF first THEN w.RawNum(sfConst); first := FALSE END;
  1963. Symbol(constant.type,constant.name,SyntaxTree.Public (*! for compatiblity should be constant.access *) ,FALSE,FALSE,FALSE,FALSE, FALSE, FALSE, 0);
  1964. constant.GetName(name);
  1965. Value(constant.value.resolved(SyntaxTree.Value))
  1966. END;
  1967. constant := constant.nextConstant;
  1968. END;
  1969. (* variables *)
  1970. IF TraceExport IN Trace THEN
  1971. D.Str("exporting variables "); D.Ln;
  1972. END;
  1973. first := TRUE;
  1974. variable := module.moduleScope.firstVariable;
  1975. WHILE variable # NIL DO
  1976. IF variable.access * SyntaxTree.Public # {} THEN
  1977. IF first THEN w.RawNum(sfVar); first := FALSE END;
  1978. Symbol(variable.type,variable.name,variable.access,variable.untraced, FALSE, FALSE, FALSE, FALSE, variable.fictive, variable.fictiveOffset);
  1979. END;
  1980. variable := variable.nextVariable;
  1981. END;
  1982. (* procedures: normal *)
  1983. IF TraceExport IN Trace THEN
  1984. D.Str("exporting procedures "); D.Ln;
  1985. END;
  1986. first := TRUE;
  1987. procedure := module.moduleScope.firstProcedure;
  1988. WHILE procedure # NIL DO
  1989. IF (procedure.access * SyntaxTree.Public # {}) & ~(procedure IS SyntaxTree.Operator) THEN
  1990. procedureType := procedure.type(SyntaxTree.ProcedureType);
  1991. IF ~procedure.isInline THEN
  1992. IF first THEN w.RawNum(sfXProcedure); first := FALSE END;
  1993. Symbol(procedureType.returnType,procedure.name,SyntaxTree.Public (*! for compatiblity should be procedure.access *),
  1994. FALSE, procedureType.isRealtime, procedure.isConstructor, FALSE, FALSE, FALSE, 0);
  1995. ParameterList(procedureType);
  1996. END;
  1997. END;
  1998. procedure := procedure.nextProcedure;
  1999. END;
  2000. (* procedures: operators *)
  2001. IF TraceExport IN Trace THEN
  2002. D.Str("exporting operators"); D.Ln;
  2003. END;
  2004. first := TRUE;
  2005. procedure := module.moduleScope.firstProcedure;
  2006. WHILE procedure # NIL DO
  2007. IF (procedure.access * SyntaxTree.Public # {}) & (procedure IS SyntaxTree.Operator) THEN
  2008. procedureType := procedure.type(SyntaxTree.ProcedureType);
  2009. IF first THEN w.RawNum(sfOperator); first := FALSE END;
  2010. Symbol(procedureType.returnType,procedure.name,SyntaxTree.Public (*! for compatiblity should be procedure.access *),
  2011. FALSE, procedure.isInline, procedure.isConstructor, FALSE, procedure(SyntaxTree.Operator).isDynamic, FALSE, 0);
  2012. ParameterList(procedureType);
  2013. IF procedure.isInline THEN
  2014. w.RawNum(sfInline); Inline(procedure.procedureScope);
  2015. END;
  2016. END;
  2017. procedure := procedure.nextProcedure;
  2018. END;
  2019. (* procedures: inline *)
  2020. IF TraceExport IN Trace THEN
  2021. D.Str("exporting inline procedures"); D.Ln;
  2022. END;
  2023. first := TRUE;
  2024. procedure := module.moduleScope.firstProcedure;
  2025. WHILE procedure # NIL DO
  2026. IF (procedure.access * SyntaxTree.Public # {}) & ~(procedure IS SyntaxTree.Operator) THEN
  2027. procedureType := procedure.type(SyntaxTree.ProcedureType);
  2028. IF procedure.isInline THEN
  2029. IF first THEN w.RawNum(sfCProcedure); first := FALSE END;
  2030. Symbol(procedureType.returnType,procedure.name,SyntaxTree.Public (*! for compatiblity should be procedure.access *),
  2031. FALSE, procedure.isInline, procedure.isConstructor, FALSE, FALSE, FALSE, 0);
  2032. ParameterList(procedureType);
  2033. Inline(procedure.procedureScope);
  2034. END;
  2035. END;
  2036. procedure := procedure.nextProcedure;
  2037. END;
  2038. (* type declarations: aliases *)
  2039. IF TraceExport IN Trace THEN
  2040. D.Str("exporting type declarations aliases"); D.Ln;
  2041. END;
  2042. first := TRUE;
  2043. typeDeclaration := module.moduleScope.firstTypeDeclaration;
  2044. WHILE typeDeclaration # NIL DO
  2045. IF typeDeclaration.access * SyntaxTree.Public # {} THEN
  2046. IF typeDeclaration.declaredType IS SyntaxTree.QualifiedType THEN
  2047. IF first THEN w.RawNum(sfAlias); first := FALSE END;
  2048. Type(typeDeclaration.declaredType);
  2049. typeDeclaration.GetName(name);
  2050. w.RawString(name);
  2051. END;
  2052. END;
  2053. typeDeclaration := typeDeclaration.nextTypeDeclaration;
  2054. END;
  2055. (* type declarations: declarations *)
  2056. IF TraceExport IN Trace THEN
  2057. D.Str("exporting type declarations"); D.Ln;
  2058. END;
  2059. first := TRUE;
  2060. typeDeclaration := module.moduleScope.firstTypeDeclaration;
  2061. WHILE typeDeclaration # NIL DO
  2062. IF typeDeclaration.access * SyntaxTree.Public # {} THEN
  2063. IF ~(typeDeclaration.declaredType IS SyntaxTree.QualifiedType) THEN
  2064. IF first THEN w.RawNum(sfType); first := FALSE END;
  2065. Type(typeDeclaration.declaredType);
  2066. END;
  2067. END;
  2068. typeDeclaration := typeDeclaration.nextTypeDeclaration;
  2069. END;
  2070. IF TraceExport IN Trace THEN
  2071. module.GetName(name);
  2072. D.Str("BINARY SYMBOL FILE EXPORT DONE "); D.Str(name); D.Ln;
  2073. END;
  2074. w.RawNum(sfEnd);
  2075. END Module;
  2076. BEGIN
  2077. file := Files.New("");
  2078. IF ~noInterfaceCheck THEN
  2079. InterfaceComparison.CompareThis(module,SELF,diagnostics,importCache,flags);
  2080. IF noRedefinition OR noModification THEN
  2081. IF (InterfaceComparison.Redefined IN flags) THEN
  2082. Basic.Error(diagnostics, module.sourceName, Basic.invalidPosition, " no redefinition of symbol file allowed");
  2083. RETURN FALSE;
  2084. END;
  2085. END;
  2086. IF noModification THEN
  2087. IF (InterfaceComparison.Extended IN flags) THEN
  2088. Basic.Error(diagnostics, module.sourceName,Basic.invalidPosition, " no extension of symbol file allowed");
  2089. RETURN FALSE;
  2090. END;
  2091. END;
  2092. END;
  2093. NEW(w,file,0);
  2094. NEW(lookup,100); NEW(indexToAttribute,16);
  2095. numberType := 0;
  2096. Module(module);
  2097. w.Update();
  2098. Files.Register(file);
  2099. RETURN TRUE
  2100. END Export;
  2101. PROCEDURE DefineOptions*(options: Options.Options);
  2102. BEGIN
  2103. options.Add(0X,"symbolFileExtension",Options.String);
  2104. options.Add(0X,"noRedefinition",Options.Flag);
  2105. options.Add(0X,"noModification",Options.Flag);
  2106. options.Add(0X,"noInterfaceCheck",Options.Flag);
  2107. END DefineOptions;
  2108. PROCEDURE GetOptions*(options: Options.Options);
  2109. BEGIN
  2110. IF ~options.GetString("symbolFileExtension",extension) THEN
  2111. extension := Machine.DefaultObjectFileExtension
  2112. END;
  2113. noRedefinition := options.GetFlag("noRedefinition");
  2114. noModification := options.GetFlag("noModification");
  2115. noInterfaceCheck := options.GetFlag("noInterfaceCheck");
  2116. END GetOptions;
  2117. END BinarySymbolFile;
  2118. VAR
  2119. (* move to basic *)
  2120. PROCEDURE MakeFileName(VAR file: ARRAY OF CHAR; CONST name, prefix, suffix: ARRAY OF CHAR);
  2121. VAR i, j: LONGINT;
  2122. BEGIN
  2123. i := 0; WHILE prefix[i] # 0X DO file[i] := prefix[i]; INC(i) END;
  2124. j := 0; WHILE name[j] # 0X DO file[i+j] := name[j]; INC(j) END;
  2125. INC(i, j);
  2126. j := 0; WHILE suffix[j] # 0X DO file[i+j] := suffix[j]; INC(j) END;
  2127. file[i+j] := 0X;
  2128. END MakeFileName;
  2129. (** OpenSymFile - Open a symfile for reading *)
  2130. PROCEDURE OpenSymFile(CONST name,prefix,suffix: ARRAY OF CHAR; VAR r: Streams.Reader; VAR version: CHAR): BOOLEAN;
  2131. VAR res: BOOLEAN; file: Files.FileName; f: Files.File; R: Files.Reader; dummy: LONGINT; ch: CHAR;
  2132. BEGIN
  2133. res := FALSE;
  2134. MakeFileName(file, name, prefix, suffix);
  2135. f := Files.Old(file);
  2136. IF f # NIL THEN
  2137. NEW(R,f,0);
  2138. r := R;
  2139. r.Char(ch);
  2140. IF ch = FileTag THEN
  2141. r.Char(version);
  2142. ASSERT(version = NoZeroCompress); r.Char(version);
  2143. IF version = FileVersion THEN
  2144. r.RawNum(dummy); (*skip symfile size*)
  2145. ELSIF (version >= FileVersionOC) & (version <= FileVersionCurrent) THEN
  2146. r.RawLInt(dummy); (* new in OC: symbol file size uncompressed *)
  2147. ELSE
  2148. HALT(100)
  2149. END;
  2150. res := TRUE
  2151. END
  2152. END;
  2153. RETURN res
  2154. END OpenSymFile;
  2155. PROCEDURE Get*(): Formats.SymbolFileFormat;
  2156. VAR symbolFileFormat: BinarySymbolFile;
  2157. BEGIN
  2158. NEW(symbolFileFormat); symbolFileFormat.file := Files.New(""); RETURN symbolFileFormat
  2159. END Get;
  2160. PROCEDURE Test*(context: Commands.Context);
  2161. VAR moduleName: SyntaxTree.IdentifierString; module: SyntaxTree.Module;
  2162. log2: Basic.Writer; time: LONGINT;
  2163. p: Printout.Printer;
  2164. symbolFileFormat: BinarySymbolFile;
  2165. options: Options.Options;
  2166. extension: Basic.FileName;
  2167. BEGIN
  2168. NEW(options);
  2169. NEW(symbolFileFormat);
  2170. symbolFileFormat.DefineOptions(options);
  2171. IF options.Parse(context.arg,context.error) THEN
  2172. symbolFileFormat.GetOptions(options);
  2173. context.arg.SkipWhitespace; context.arg.String(moduleName);
  2174. time := Kernel.GetTicks();
  2175. symbolFileFormat.Initialize(NIL,Global.DefaultSystem(),"");
  2176. module := symbolFileFormat.Import(moduleName,NIL);
  2177. time := Kernel.GetTicks()-time;
  2178. D.Str("importer elapsed ms: "); D.Int(time,10); D.Ln;
  2179. D.Update;
  2180. log2 := Basic.GetWriter(Basic.GetDebugWriter("SymbolFile"));
  2181. p := Printout.NewPrinter(log2,Printout.SymbolFile,FALSE);
  2182. log2.String("Interface of "); log2.String(moduleName); log2.Ln;
  2183. log2.Ln;
  2184. p.Module(module);
  2185. log2.Ln;
  2186. log2.Ln;
  2187. log2.String(" -------------------------------------------------------------- "); log2.Ln;
  2188. log2.Ln;
  2189. log2.Ln;
  2190. p := Printout.NewPrinter(log2,Printout.All,TRUE);
  2191. p.Module(module);
  2192. log2.Update;
  2193. END;
  2194. END Test;
  2195. END FoxBinarySymbolFile.
  2196. SystemTools.Free FoxBinarySymbolFile ~
  2197. FoxBinarySymbolFile.Test Visualizer ~
  2198. Compiler.Compile -PCtp Visualizer.Sym ~
  2199. FoxBinarySymbolFile.Test Oberon.Oberon ~
  2200. FoxBinarySymbolFile.Test --symbolFileExtension=".Obw" Dump ~