FoxBinarySymbolFile.Mod 87 KB

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