FoxFingerPrinter.Mod 45 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385
  1. MODULE FoxFingerPrinter; (** AUTHOR "fof"; PURPOSE "FingerPrinting"; *)
  2. (* literature for the fingerprinting: Dissertation Crelier *)
  3. IMPORT SyntaxTree := FoxSyntaxTree, Basic := FoxBasic, SYSTEM, Global := FoxGlobal,Scanner := FoxScanner,
  4. D := Debugging, Streams;
  5. (** FingerPrinting
  6. FP(TypeDeclaration) = 0 <*> fpModeType -> Name -> Visibility <*> FP(Type).
  7. FP(ConstantDeclaration) = 0 <*> fpModeConstant -> Name -> Visibility <*> FP(Type) -> Basic -> Value.
  8. FP(VariableDeclaration) = 0 <*> fpModePar -> Name -> Visibility <*> FP(Type).
  9. FP(ProcedureDeclaration) = 0 <*> fpModeInlineProcedure -> Name -> Visibility <*> FP(Type) -> Code.
  10. | 0 <*> fpModeExportedProcedure -> Name -> Visibility <*> FP(Type)
  11. Name(fp,name) = fp <*> name[0] <*> ... <*> name[n].
  12. Visibility(fp,vis) = fp <*> fpExtern | fp <*> fpExternR | fp <*> fpOther <*> vis.
  13. Value(fp) = fp <*> fpTrue | fp <*> fpFalse | fp <*> integer | fp <*> intlow <*> inthigh | fp -> Name
  14. FP(Type) = FP(BasicType) | FP(RecordType) | FP(PointerType)
  15. | FP(ArrayType) | FP(MathArrayType) | FP(ProcedurType)
  16. FP(BasicType) = fpTypeChar8 | fpTypeChar16 | fpTypeChar32
  17. | fpTypeShortint | fpTypeInteger | fpTypeLongint | fpTypeHugeint
  18. | fpTypeReal | fpTypeLongreal
  19. | fpTypeSet | fpTypePointer |fpTypeString
  20. | fpTypeByte | fpTypeAll | fpTypeSame | fpTypeRange | fpTypeBoolean.
  21. PublicFP(BasicType) = FP(basicType).
  22. PrivateFP(BasicType) = sizeof(basicType).
  23. FP(RecordType) = fpTypeComposite <*> fptypeRecord
  24. [ -> Name(moduleName) -> Name(typeName)] [<*> FP(baseType)]
  25. PublicFP(RecordType) = FP(recordType) [<*> PublicFP(baseType)] {<*> FP(method) <*> methodNumber }
  26. {<*> PublicFP(fieldType) <*> offset(field) <*> FP(field)} <*> flags.
  27. PrivateFP(RecordType) = FP(recordType) [<*> PrivateFP(baseType)] {<*> FP(method) <*> methodNumber }
  28. {<*> PrivateFP(fieldType) <*> offset(field) <*> FP(field)}
  29. FP(Method) = 0 <*> fpModeMethod -> Name(methodName) -> Signature(method).
  30. FP(Field) = 0 <*> fpModeField -> Name(fieldName) -> Visibility [<*> fpUntraced] <*> FP(type).
  31. FP(PointerType) = fpTypePointer <*> fpTypeBasic -> Name <*> FP(baseType).
  32. PublicFP(PointerType) = 0.
  33. PrivateFP(PointerType) = 0.
  34. FP(ArrayType) = fpTypeComposite <*> (fpTypeOpenArray | fpTypeStaticArray)
  35. -> Name <*> FP(baseType) [<*> length].
  36. PublicFP(ArrayType) = FP(arrayType).
  37. PrivateFP(ArrayType) = FP(arrayType).
  38. FP(MathArrayType) = fpTypeComposite <*> (fpTypeOpenArray | fpTypeStaticArray)
  39. -> Name <*> FP(baseType) [<*> length].
  40. PublicFP(MathArrayType) = FP(arrayType).
  41. PrivateFP(MathArrayType) = FP(arrayType).
  42. FP(ProcedureType) = fpTypeProcedure <*> fpTypeBasic [<*> fpDelegate]-> Name.
  43. PublicFP(ProcedureType) = FP(arrayType) -> Signature(procedureType)
  44. PrivateFP(ProcedureType) = FP(arrayType)-> Signature(procedureType).
  45. Signature(f) = f <*> FP(returnType)
  46. { <*> (fpModeVarParameter | fpModeConstParameter | fpModePar)
  47. <*> FP(parameterType) [-> Name(parameterName)] }
  48. **)
  49. CONST
  50. (*FingerPrints/Obj Modes*)
  51. fpModeVar=1;
  52. fpModePar=1;
  53. fpModeVarPar=2;
  54. fpModeConstPar=fpModeVarPar; (*! for compatibility, must be changed *)
  55. fpModeConst=3;
  56. fpModeField=4;
  57. fpModeType=5;
  58. fpModeExportedProcedure=7;
  59. fpModeInlineProcedure=9;
  60. fpModeMethod=13;
  61. (*FingerPrints/Type Forms*)
  62. fpTypeByte = 1;
  63. fpTypeBoolean=2;
  64. fpTypeChar8=3;
  65. fpTypeShortint=4;
  66. fpTypeInteger=5;
  67. fpTypeLongint=6;
  68. fpTypeReal=7;
  69. fpTypeLongreal=8;
  70. fpTypeSet=9;
  71. fpTypeString=10;
  72. fpTypeNone = 12;
  73. fpTypePointer=13;
  74. fpTypeProcedure=14;
  75. fpTypeComposite=15;
  76. fpTypeHugeint=16;
  77. fpTypeChar16 = 17;
  78. fpTypeChar32 = 18;
  79. fpTypeAll = 19;
  80. fpTypeSame = 20;
  81. fpTypeRange = 21;
  82. fpTypeEnum = 22;
  83. fpTypePort = 23;
  84. fpTypeChannel = 23;
  85. fpTypeComplex = 24;
  86. fpTypeLongcomplex = 25;
  87. fpTypeModule=26;
  88. fpTypeBasic=1;
  89. fpTypeStaticArray=2;
  90. fpTypeDynamicArray=4;
  91. fpTypeOpenArray=5;
  92. fpTypeRecord=6;
  93. fpIntern=0;
  94. fpExtern=1;
  95. fpExternR=2;
  96. fpOther =3;
  97. fpFalse=0;
  98. fpTrue=1;
  99. fpHasBody = 1;
  100. fpProtected =4;
  101. fpActive = 5;
  102. fpDelegate = 5;
  103. fpSystemType = 6;
  104. fpUntraced = 4;
  105. Trace=FALSE;
  106. TYPE
  107. FingerPrint = SyntaxTree.FingerPrint;
  108. FingerPrinter*= OBJECT (SyntaxTree.Visitor)
  109. VAR
  110. fp-: LONGINT; (* temporary fingerprint for values etc. *)
  111. fingerprint: FingerPrint;
  112. deep: BOOLEAN; (* public / private field of FP needed ? *)
  113. traceLevel: LONGINT;
  114. level: LONGINT;
  115. PROCEDURE & InitFingerPrinter*();
  116. BEGIN fp:= 0; deep := FALSE; traceLevel := 0;
  117. END InitFingerPrinter;
  118. (** types *)
  119. (*
  120. FP(BasicType) = | fpTypeByte | fpTypeAll | fpTypeSame | fpTypeRange | fpTypeBoolean.
  121. | fpTypeSet | fpTypePointer
  122. PublicFP(BasicType) = FP(basicType).
  123. PrivateFP(BasicType) = sizeof(basicType).
  124. *)
  125. PROCEDURE VisitBasicType(x: SyntaxTree.BasicType);
  126. BEGIN
  127. END VisitBasicType;
  128. PROCEDURE SetTypeFingerprint(x: SyntaxTree.Type; fp: LONGINT);
  129. VAR fingerprint: FingerPrint;
  130. BEGIN
  131. fingerprint := x.fingerprint;
  132. IF ~fingerprint.shallowAvailable THEN
  133. fingerprint.shallow := fp;
  134. fingerprint.public := fp;
  135. fingerprint.private := fp;
  136. fingerprint.shallowAvailable := TRUE;
  137. fingerprint.deepAvailable := TRUE; (* no distinction between deep and shallow fp necessary *)
  138. x.SetFingerPrint(fingerprint);
  139. END;
  140. SELF.fingerprint := fingerprint;
  141. END SetTypeFingerprint;
  142. PROCEDURE VisitRangeType(x: SyntaxTree.RangeType);
  143. VAR fingerprint: FingerPrint;
  144. BEGIN
  145. SetTypeFingerprint(x,fpTypeRange);
  146. END VisitRangeType;
  147. PROCEDURE VisitBooleanType(x: SyntaxTree.BooleanType);
  148. BEGIN
  149. SetTypeFingerprint(x,fpTypeBoolean);
  150. END VisitBooleanType;
  151. PROCEDURE VisitByteType(x: SyntaxTree.ByteType);
  152. BEGIN
  153. SetTypeFingerprint(x,fpTypeByte)
  154. END VisitByteType;
  155. PROCEDURE VisitSetType(x: SyntaxTree.SetType);
  156. BEGIN
  157. SetTypeFingerprint(x,fpTypeSet)
  158. END VisitSetType;
  159. PROCEDURE VisitNilType(x: SyntaxTree.NilType);
  160. BEGIN
  161. SetTypeFingerprint(x,fpTypePointer)
  162. END VisitNilType;
  163. PROCEDURE VisitAnyType(x: SyntaxTree.AnyType);
  164. BEGIN
  165. SetTypeFingerprint(x,fpTypePointer)
  166. END VisitAnyType;
  167. PROCEDURE VisitAddressType(x: SyntaxTree.AddressType);
  168. BEGIN
  169. SetTypeFingerprint(x,fpTypePointer)
  170. END VisitAddressType;
  171. PROCEDURE VisitSizeType(x: SyntaxTree.SizeType);
  172. BEGIN
  173. IF x.sizeInBits=8 THEN SetTypeFingerprint(x,fpTypeShortint)
  174. ELSIF x.sizeInBits = 16 THEN SetTypeFingerprint(x,fpTypeInteger)
  175. ELSIF x.sizeInBits = 32 THEN SetTypeFingerprint(x,fpTypeLongint)
  176. ELSIF x.sizeInBits = 64 THEN SetTypeFingerprint(x,fpTypeHugeint)
  177. ELSE HALT(100)
  178. END;
  179. END VisitSizeType;
  180. PROCEDURE VisitObjectType(x: SyntaxTree.ObjectType);
  181. BEGIN
  182. SetTypeFingerprint(x,fpTypePointer)
  183. END VisitObjectType;
  184. (*
  185. FP(BasicType) = fpTypeChar8 | fpTypeChar16 | fpTypeChar32
  186. PublicFP(BasicType) = FP(basicType).
  187. PrivateFP(BasicType) = sizeof(basicType).
  188. *)
  189. PROCEDURE VisitCharacterType(x: SyntaxTree.CharacterType);
  190. BEGIN
  191. IF x.sizeInBits = 8 THEN SetTypeFingerprint(x,fpTypeChar8)
  192. ELSIF x.sizeInBits = 16 THEN SetTypeFingerprint(x,fpTypeChar16)
  193. ELSIF x.sizeInBits =32 THEN SetTypeFingerprint(x,fpTypeChar32)
  194. ELSE HALT(100)
  195. END;
  196. END VisitCharacterType;
  197. (*
  198. FP(BasicType) = fpTypeShortint | fpTypeInteger | fpTypeLongint | fpTypeLongint
  199. PublicFP(BasicType) = FP(basicType).
  200. PrivateFP(BasicType) = sizeof(basicType).
  201. *)
  202. PROCEDURE VisitIntegerType(x: SyntaxTree.IntegerType);
  203. BEGIN
  204. IF x.sizeInBits=8 THEN SetTypeFingerprint(x,fpTypeShortint)
  205. ELSIF x.sizeInBits = 16 THEN SetTypeFingerprint(x,fpTypeInteger)
  206. ELSIF x.sizeInBits = 32 THEN SetTypeFingerprint(x,fpTypeLongint)
  207. ELSIF x.sizeInBits = 64 THEN SetTypeFingerprint(x,fpTypeHugeint)
  208. ELSE HALT(100)
  209. END;
  210. END VisitIntegerType;
  211. (*
  212. FP(BasicType) = fpTypeReal | fpTypeLongreal
  213. PublicFP(BasicType) = FP(basicType).
  214. PrivateFP(BasicType) = sizeof(basicType).
  215. *)
  216. PROCEDURE VisitFloatType(x: SyntaxTree.FloatType);
  217. BEGIN
  218. IF x.sizeInBits = 32 THEN SetTypeFingerprint(x,fpTypeReal)
  219. ELSIF x.sizeInBits = 64 THEN SetTypeFingerprint(x,fpTypeLongreal)
  220. ELSE HALT(100)
  221. END;
  222. END VisitFloatType;
  223. PROCEDURE VisitComplexType(x: SyntaxTree.ComplexType);
  224. BEGIN
  225. ASSERT(x.componentType # NIL);
  226. IF x.componentType.sizeInBits = 32 THEN SetTypeFingerprint(x,fpTypeComplex)
  227. ELSIF x.componentType.sizeInBits = 64 THEN SetTypeFingerprint(x,fpTypeLongcomplex)
  228. ELSE HALT(100)
  229. END
  230. END VisitComplexType;
  231. (*
  232. FP(BasicType) = fpStringType
  233. PublicFP(BasicType) = FP(basicType).
  234. PrivateFP(BasicType) = sizeof(basicType).
  235. *)
  236. PROCEDURE VisitStringType(x: SyntaxTree.StringType);
  237. BEGIN
  238. SetTypeFingerprint(x,fpTypeString);
  239. END VisitStringType;
  240. (**
  241. fp enumeration type
  242. **)
  243. PROCEDURE VisitEnumerationType(x: SyntaxTree.EnumerationType);
  244. VAR fingerprint: FingerPrint; enumerator: SyntaxTree.Constant; fp: LONGINT;
  245. BEGIN
  246. fingerprint := x.fingerprint;
  247. IF ~fingerprint.shallowAvailable THEN
  248. fp := fpTypeEnum;
  249. IF x.enumerationBase # NIL THEN
  250. FPType(fp,x.enumerationBase);
  251. END;
  252. enumerator := x.enumerationScope.firstConstant;
  253. WHILE enumerator # NIL DO
  254. IF enumerator.access * SyntaxTree.Public # {} THEN
  255. FPName(fp,enumerator.name);
  256. END;
  257. FPValue(fp,enumerator.value);
  258. enumerator := enumerator.nextConstant;
  259. END;
  260. fingerprint.shallow := fp;
  261. fingerprint.public := fingerprint.shallow;
  262. fingerprint.private := fingerprint.shallow;
  263. fingerprint.shallowAvailable := TRUE;
  264. fingerprint.deepAvailable := TRUE; (* no distinction between deep and shallow fp necessary *)
  265. x.SetFingerPrint(fingerprint);
  266. END;
  267. SELF.fingerprint := fingerprint
  268. (*! must be implemented
  269. IF x.enumerationBase # NIL THEN
  270. baseType := ResolveType(x.enumerationBase);
  271. resolved := baseType.resolved;
  272. enumerationBase := resolved(SyntaxTree.EnumerationType);
  273. baseScope := enumerationBase.enumerationScope;
  274. x.SetBaseValue(enumerationBase.baseValue + baseScope.numberEnumerators);
  275. END;
  276. CheckEnumerationScope(x.enumerationScope);
  277. x.SetState(SyntaxTree.Resolved);
  278. END;
  279. resolvedType := ResolvedType(x);
  280. *)
  281. END VisitEnumerationType;
  282. PROCEDURE VisitQualifiedType(x: SyntaxTree.QualifiedType);
  283. BEGIN
  284. x.resolved.Accept(SELF);
  285. END VisitQualifiedType;
  286. (*
  287. FP(ArrayType) = fpTypeComposite <*> (fpTypeOpenArray | fpTypeStaticArray)
  288. -> Name <*> FP(baseType) [<*> length].
  289. PublicFP(ArrayType) = FP(arrayType).
  290. PrivateFP(ArrayType) = FP(arrayType).
  291. *)
  292. PROCEDURE VisitArrayType(x: SyntaxTree.ArrayType);
  293. VAR fingerprint: FingerPrint; deep: BOOLEAN; fp: LONGINT;
  294. BEGIN
  295. IF Trace THEN TraceEnter("ArrayType") END;
  296. fingerprint := x.fingerprint;
  297. deep := SELF.deep;
  298. IF ~fingerprint.shallowAvailable THEN
  299. fingerprint.shallowAvailable := TRUE; (* the fingerprinting may return to itself => avoid circles *)
  300. SELF.deep := FALSE;
  301. fp := 0;
  302. FPNumber(fp,fpTypeComposite);
  303. IF x.form = SyntaxTree.Open THEN FPNumber(fp,fpTypeOpenArray)
  304. ELSIF x.form = SyntaxTree.Static THEN FPNumber(fp,fpTypeStaticArray)
  305. ELSIF x.form = SyntaxTree.SemiDynamic THEN FPNumber(fp, fpTypeDynamicArray);
  306. ELSE HALT(200)
  307. END;
  308. TypeName(fp,x);
  309. fingerprint.shallow := fp;
  310. x.SetFingerPrint(fingerprint);
  311. FPType(fp,x.arrayBase.resolved);
  312. IF x.form = SyntaxTree.Static THEN FPNumber(fp,x.staticLength) END;
  313. fingerprint.shallow := fp;
  314. fingerprint.public := fingerprint.shallow;
  315. fingerprint.private := fingerprint.shallow;
  316. x.SetFingerPrint(fingerprint);
  317. SELF.deep := deep;
  318. END;
  319. IF deep & ~fingerprint.deepAvailable THEN
  320. fingerprint.private := fingerprint.shallow;
  321. fingerprint.public := fingerprint.shallow;
  322. fingerprint.deepAvailable := TRUE; (* to avoid circles during base finger printing *)
  323. x.SetFingerPrint(fingerprint);
  324. x.arrayBase.Accept(SELF); (* make sure that base pointer is also deeply fped *)
  325. END;
  326. IF Trace THEN TraceExit("ArrayType",fingerprint) END;
  327. SELF.fingerprint := fingerprint;
  328. END VisitArrayType;
  329. (*
  330. FP(MathArrayType) = fpTypeComposite <*> (fpTypeOpenArray | fpTypeStaticArray)
  331. -> Name <*> FP(baseType) [<*> length].
  332. PublicFP(MathArrayType) = FP(arrayType).
  333. PrivateFP(MathArrayType) = FP(arrayType).
  334. *)
  335. PROCEDURE VisitMathArrayType(x: SyntaxTree.MathArrayType);
  336. VAR fingerprint: FingerPrint; deep: BOOLEAN; fp: LONGINT;
  337. BEGIN
  338. fingerprint := x.fingerprint;
  339. deep := SELF.deep;
  340. IF Trace THEN TraceEnter("MathArrayType") END;
  341. IF ~fingerprint.shallowAvailable THEN
  342. fingerprint.shallowAvailable := TRUE; (* the fingerprinting may return to itself => avoid circles *)
  343. SELF.deep := FALSE;
  344. fp := 0;
  345. FPNumber(fp,fpTypeComposite);
  346. IF x.form = SyntaxTree.Open THEN FPNumber(fp,fpTypeOpenArray)
  347. ELSIF x.form = SyntaxTree.Static THEN FPNumber(fp,fpTypeStaticArray)
  348. ELSIF x.form = SyntaxTree.Tensor THEN (* do nothing *)
  349. ELSE HALT(200)
  350. END;
  351. TypeName(fp,x);
  352. IF x.arrayBase # NIL THEN
  353. FPType(fp,x.arrayBase.resolved);
  354. END;
  355. IF x.form = SyntaxTree.Static THEN FPNumber(fp,x.staticLength) END;
  356. fingerprint.shallow := fp;
  357. fingerprint.public := fingerprint.shallow;
  358. fingerprint.private := fingerprint.shallow;
  359. fingerprint.shallowAvailable := TRUE;
  360. x.SetFingerPrint(fingerprint);
  361. SELF.deep := deep;
  362. END;
  363. IF deep & ~fingerprint.deepAvailable THEN
  364. x.arrayBase.Accept(SELF);
  365. fingerprint.private := fingerprint.shallow;
  366. fingerprint.public := fingerprint.shallow;
  367. fingerprint.deepAvailable := TRUE;
  368. x.SetFingerPrint(fingerprint);
  369. END;
  370. IF Trace THEN TraceExit("MathArrayType",fingerprint) END;
  371. SELF.fingerprint := fingerprint;
  372. END VisitMathArrayType;
  373. (*
  374. fp = fp [ -> Name(moduleName) -> Name(typeName) ]
  375. *)
  376. PROCEDURE TypeName(VAR fp: LONGINT; x:SyntaxTree.Type);
  377. VAR typeDeclaration: SyntaxTree.TypeDeclaration;
  378. BEGIN
  379. IF (x.scope # NIL) THEN
  380. (* only executed for imported types, reason:
  381. modification of a type name would result in modified fingerprint leading to modified fingerprints of using structures such as
  382. in the following example:
  383. TYPE A=ARRAY 32 OF CHAR;
  384. PROCEDURE P*(a:A);
  385. ...
  386. END P;
  387. IF name of A was changed, P would get a new fingerprint.
  388. Better: fingerprint of P only depends in type of A but not on its declared name.
  389. *)
  390. IF Trace THEN
  391. TraceIndent;
  392. D.Str("TypeName ");
  393. D.Str0(x.scope.ownerModule.name);
  394. END;
  395. typeDeclaration := x.typeDeclaration;
  396. IF(typeDeclaration # NIL) & (typeDeclaration.access # SyntaxTree.Hidden) THEN
  397. FPName(fp,x.scope.ownerModule.name);
  398. IF (typeDeclaration.declaredType.resolved # x) THEN
  399. (* in record type: pointer to type declaration of a pointer *)
  400. typeDeclaration := NIL
  401. END;
  402. IF (typeDeclaration # NIL) & (typeDeclaration.scope # NIL)THEN
  403. FPName(fp,typeDeclaration.name);
  404. IF Trace THEN
  405. D.Str(".");
  406. D.Str0(typeDeclaration.name);
  407. END;
  408. ELSIF (typeDeclaration # NIL) & (typeDeclaration.scope = NIL) THEN
  409. D.Str("typedeclaration without scope: "); D.Str0(x.typeDeclaration.name); D.Int(x.typeDeclaration.position.start,5); D.Ln;
  410. D.Update;
  411. ELSE
  412. FPNumber(fp,0);
  413. END;
  414. ELSE
  415. FPNumber(fp, 0);
  416. END;
  417. IF Trace THEN
  418. D.Str(", fp = "); D.Hex(fp,-8); D.Ln;
  419. END
  420. END
  421. END TypeName;
  422. (*
  423. FP(PointerType) = fpTypePointer <*> fpTypeBasic -> Name <*> FP(baseType).
  424. PublicFP(PointerType) = 0.
  425. PrivateFP(PointerType) = 0.
  426. *)
  427. PROCEDURE VisitPointerType(x: SyntaxTree.PointerType);
  428. VAR fingerprint,typeFP: FingerPrint; fp: LONGINT; deep: BOOLEAN;
  429. BEGIN
  430. IF Trace THEN TraceEnter("PointerType"); END;
  431. fingerprint := x.fingerprint;
  432. deep := SELF.deep;
  433. IF ~fingerprint.shallowAvailable THEN
  434. IF Trace THEN TraceIndent; D.Str("PointerType shallow");D.Ln; END;
  435. SELF.deep := FALSE;
  436. fp := 0;
  437. FPNumber(fp, fpTypePointer); FPNumber(fp, fpTypeBasic);
  438. TypeName(fp,x);
  439. FPType(fp,x.pointerBase);
  440. fingerprint.shallow := fp;
  441. fingerprint.private := fp;
  442. fingerprint.public := fp;
  443. fingerprint.shallowAvailable := TRUE;
  444. fingerprint.deepAvailable := TRUE;
  445. (*
  446. deep fingerprinting leads to cycles -> must be done on record type directly, if a deep FP is needed
  447. IF deep & ~fingerprint.deepAvailable THEN
  448. IF Trace THEN TraceIndent; D.Str("PointerType:deep");D.Ln; END;
  449. x.pointerBase.Accept(SELF);
  450. fingerprint.deepAvailable := TRUE;
  451. END;
  452. *)
  453. x.SetFingerPrint(fingerprint);
  454. SELF.deep := deep;
  455. END;
  456. IF Trace THEN TraceExit("PointerType",fingerprint) END;
  457. SELF.fingerprint := fingerprint;
  458. END VisitPointerType;
  459. (*
  460. FP(PortType) = fpTypePort <*> fpTypeBasic -> Name <*> FP(baseType).
  461. PublicFP(PortType) = 0.
  462. PrivateFP(PortType) = 0.
  463. *)
  464. PROCEDURE VisitPortType(x: SyntaxTree.PortType);
  465. VAR fingerprint: FingerPrint; fp: LONGINT; deep: BOOLEAN;
  466. BEGIN
  467. IF Trace THEN TraceEnter("PortType"); END;
  468. fingerprint := x.fingerprint;
  469. deep := SELF.deep;
  470. IF ~fingerprint.shallowAvailable THEN
  471. IF Trace THEN TraceIndent; D.Str("PortType shallow");D.Ln; END;
  472. SELF.deep := FALSE;
  473. fp := 0;
  474. FPNumber(fp, fpTypePort); FPNumber(fp, fpTypeBasic);
  475. TypeName(fp,x);
  476. FPNumber(fp,x.sizeInBits);
  477. fingerprint.shallow := fp;
  478. fingerprint.private := fp;
  479. fingerprint.public := fp;
  480. fingerprint.shallowAvailable := TRUE;
  481. fingerprint.deepAvailable := TRUE;
  482. SELF.deep := deep;
  483. END;
  484. IF Trace THEN TraceExit("PortType",fingerprint) END;
  485. SELF.fingerprint := fingerprint;
  486. END VisitPortType;
  487. (*
  488. FP(Method) = 0 <*> fpModeMethod -> Name(methodName) -> Signature(method).
  489. *)
  490. PROCEDURE FPrintMethod(VAR private,public: LONGINT; procedure,body: SyntaxTree.Procedure);
  491. VAR fingerprint: FingerPrint; fp: LONGINT; name: ARRAY 256 OF CHAR;
  492. BEGIN
  493. IF Trace THEN TraceEnter("Method");
  494. D.Address(SYSTEM.VAL(ADDRESS,procedure));
  495. procedure.GetName(name);
  496. TraceIndent; D.Str("name = "); D.Str(name); D.Ln;
  497. END;
  498. ASSERT(deep);
  499. fingerprint := procedure.fingerprint;
  500. IF ~fingerprint.shallowAvailable THEN
  501. fp := 0;
  502. FPNumber(fp,fpModeMethod);
  503. Global.GetSymbolName(procedure,name);
  504. FPString(fp,name);
  505. FPSignature(fp,procedure.type(SyntaxTree.ProcedureType),procedure IS SyntaxTree.Operator );
  506. fingerprint.shallow := fp;
  507. fingerprint.public := fingerprint.shallow;
  508. fingerprint.private := fingerprint.shallow;
  509. fingerprint.shallowAvailable := TRUE;
  510. procedure.SetFingerPrint(fingerprint)
  511. ELSE
  512. fp := fingerprint.shallow;
  513. END;
  514. IF procedure.access * SyntaxTree.Public # {} THEN (* visible method or visible supermethod *)
  515. IF Trace THEN D.String("fp before method number"); D.Hex(fp,-8); D.Ln END;
  516. FPNumber(fp,procedure.methodNumber);
  517. IF Trace THEN D.String("fp after method number"); D.Hex(fp,-8); D.Ln END;
  518. IF procedure # body THEN
  519. FPNumber(private,fp); FPNumber(public,fp);
  520. END;
  521. END;
  522. IF Trace THEN
  523. TraceIndent; D.Str("Method, fp = "); D.Hex(private,-8); D.Str(" "); D.Hex(public,-8); D.Ln;
  524. TraceExit("Method",fingerprint)
  525. END;
  526. END FPrintMethod;
  527. PROCEDURE VisitCellType(x: SyntaxTree.CellType);
  528. VAR fingerprint: FingerPrint; fp:LONGINT; name: SyntaxTree.String;
  529. BEGIN
  530. fingerprint := x.fingerprint;
  531. deep := SELF.deep;
  532. IF ~fingerprint.shallowAvailable THEN
  533. fp := 0;
  534. TypeName(fp,x);
  535. fingerprint.shallow := fp;
  536. fingerprint.public := fp;
  537. fingerprint.private := fp;
  538. fingerprint.deepAvailable := TRUE;
  539. fingerprint.shallowAvailable := TRUE;
  540. x.SetFingerPrint(fingerprint);
  541. END;
  542. SELF.fingerprint := fingerprint
  543. END VisitCellType;
  544. (*
  545. FP(RecordType) = fpTypeComposite <*> fptypeRecord
  546. [ -> Name(moduleName) -> Name(typeName)] [<*> FP(baseType)]
  547. PublicFP(RecordType) = FP(recordType) [<*> PublicFP(baseType)] {<*> FP(method) <*> methodNumber }
  548. {<*> PublicFP(fieldType) <*> offset(field) <*> FP(field)} <*> flags.
  549. PrivateFP(RecordType) = FP(recordType) [<*> PrivateFP(baseType)] {<*> FP(method) <*> methodNumber }
  550. {<*> PrivateFP(fieldType) <*> offset(field) <*> FP(field)}
  551. *)
  552. PROCEDURE VisitRecordType(x: SyntaxTree.RecordType);
  553. VAR scope: SyntaxTree.RecordScope; fp: LONGINT; variable: SyntaxTree.Variable;
  554. fingerprint,variableFingerPrint,variableTypeFingerPrint,baseFingerPrint: FingerPrint;flags: SET;
  555. symbol: SyntaxTree.Symbol; procedure: SyntaxTree.Procedure; baseType: SyntaxTree.Type;
  556. body: SyntaxTree.Body; name: ARRAY 256 OF CHAR;
  557. deep: BOOLEAN;
  558. (* for dealing with cycles the private and public fingerprint are computed here
  559. while FP is computed completely during call of Type0 *)
  560. BEGIN
  561. fingerprint := x.fingerprint;
  562. deep := SELF.deep;
  563. IF Trace THEN TraceEnter("Record"); END;
  564. IF ~fingerprint.shallowAvailable THEN
  565. IF Trace THEN TraceIndent; D.Str("RecordType Enter Shallow "); D.Ln; END;
  566. SELF.deep := FALSE;
  567. fp := 0;
  568. FPNumber(fp, fpTypeComposite); FPNumber(fp, fpTypeRecord);
  569. TypeName(fp,x);
  570. IF Trace THEN TraceIndent; D.Str("RecordType Name ");D.Hex(fp,-8); D.Ln; END;
  571. IF (x.baseType # NIL) THEN
  572. baseType := x.GetBaseRecord();
  573. FPType(fp,baseType);
  574. END;
  575. SELF.deep := TRUE;
  576. (* methods, sorted *)
  577. scope := x.recordScope;
  578. symbol := scope.firstSymbol;
  579. WHILE symbol # NIL DO (* number and names of procedures -- method table ! *)
  580. IF symbol IS SyntaxTree.Procedure THEN
  581. procedure := symbol(SyntaxTree.Procedure);
  582. FPNumber(fp,fpModeMethod);
  583. Global.GetSymbolName(procedure,name);
  584. FPString(fp,name);
  585. IF Trace THEN TraceIndent; D.Str("RecordType Method "); TraceFP(fingerprint); D.Ln; END;
  586. END;
  587. symbol := symbol.nextSymbol
  588. END;
  589. fingerprint.shallow := fp;
  590. fingerprint.public := fingerprint.shallow;
  591. fingerprint.private := fingerprint.shallow;
  592. fingerprint.shallowAvailable := TRUE;
  593. x.SetFingerPrint(fingerprint);
  594. SELF.deep := deep;
  595. IF Trace THEN TraceIndent; D.Str("RecordType Shallow Done "); TraceFP(fingerprint); D.Ln; END;
  596. END;
  597. IF deep & ~fingerprint.deepAvailable THEN
  598. IF Trace THEN TraceIndent; D.Str("RecordType Enter Deep "); D.Ln; END;
  599. fingerprint.private := fingerprint.shallow;
  600. fingerprint.public := fingerprint.shallow;
  601. (*! finger printing for interfaces omitted *)
  602. IF Trace THEN TraceIndent; D.Str("RecordType before basetype"); TraceFP(fingerprint); D.Ln; END;
  603. (* now compute base record finger prints *)
  604. baseType := x.GetBaseRecord();
  605. IF (baseType # NIL) THEN
  606. IF baseType IS SyntaxTree.PointerType THEN baseType := baseType(SyntaxTree.PointerType).pointerBase.resolved END;
  607. baseFingerPrint := TypeFP(baseType); (* deep finger print *)
  608. FPNumber(fingerprint.private,baseFingerPrint.private);
  609. FPNumber(fingerprint.public,baseFingerPrint.public);
  610. END;
  611. scope := x.recordScope;
  612. IF Trace THEN TraceIndent; D.Str("RecordType before methods"); TraceFP(fingerprint); D.Ln; END;
  613. (* methods, sorted *)
  614. symbol := scope.firstSymbol;
  615. WHILE symbol # NIL DO
  616. IF symbol IS SyntaxTree.Procedure THEN
  617. procedure := symbol(SyntaxTree.Procedure);
  618. FPrintMethod(fingerprint.private, fingerprint.public, procedure, scope.bodyProcedure);
  619. IF Trace THEN TraceIndent; D.Str("RecordType Method "); TraceFP(fingerprint); D.Ln; END;
  620. END;
  621. symbol := symbol.nextSymbol
  622. END;
  623. IF Trace THEN TraceIndent; D.Str("RecordType after methods"); TraceFP(fingerprint); D.Ln; END;
  624. variable := scope.firstVariable;
  625. WHILE variable # NIL DO
  626. variableFingerPrint := variable.fingerprint;
  627. IF variable.access * SyntaxTree.Public # {} THEN
  628. (* variable fp = & fpModeField & Name & Visibility [& fpUntraced] & Type *)
  629. fp := 0;
  630. FPNumber(fp,fpModeField);
  631. FPName(fp,variable.name);
  632. FPVisibility(fp,variable.access);
  633. IF variable.untraced THEN FPNumber(fp,fpUntraced) END;
  634. variableTypeFingerPrint := TypeFP(variable.type); (* deep finger print *)
  635. FPNumber(fp,variableTypeFingerPrint.shallow);
  636. variableFingerPrint.shallow := fp;
  637. FPNumber(fingerprint.private,variableTypeFingerPrint.private);
  638. FPNumber(fingerprint.private,SHORT(variable.offsetInBits DIV 8));
  639. FPNumber(fingerprint.private,fp);
  640. FPNumber(fingerprint.public,variableTypeFingerPrint.public);
  641. FPNumber(fingerprint.public,SHORT(variable.offsetInBits DIV 8));
  642. FPNumber(fingerprint.public,fp);
  643. IF Trace THEN TraceIndent; D.Str("RecordType Field "); D.Str0(variable.name); D.Str(" "); TraceFP(fingerprint); D.Ln; END;
  644. ELSE
  645. fp := 0;
  646. IF variable.untraced THEN FPNumber(fp,fpUntraced) END;
  647. FPNumber(fingerprint.private,fp);
  648. IF Trace THEN TraceIndent; D.Str("RecordType InvisibleField "); TraceFP(fingerprint); D.Ln; END;
  649. END;
  650. variable := variable.nextVariable;
  651. END;
  652. FPNumber(fingerprint.private, SHORT(x.sizeInBits DIV 8));
  653. FPNumber(fingerprint.public, SHORT(x.sizeInBits DIV 8));
  654. flags := {};
  655. IF x.recordScope.bodyProcedure # NIL THEN
  656. body := x.recordScope.bodyProcedure.procedureScope.body;
  657. INCL(flags, fpHasBody);
  658. IF body # NIL THEN
  659. IF body.isActive THEN INCL(flags,fpActive) END;
  660. IF body.isExclusive THEN INCL(flags,fpProtected) END;
  661. END;
  662. IF Trace THEN TraceIndent; D.Str("RecordType Body "); TraceFP(fingerprint); D.Ln; END;
  663. END;
  664. IF x.IsProtected() THEN INCL(flags,fpProtected) END;
  665. FPSet(fingerprint.public, flags);
  666. IF Trace THEN TraceIndent; D.Str("RecordType Exit Deep "); TraceFP(fingerprint); D.Ln; END;
  667. (*
  668. ASSERT(fingerprint.private # 0,100);
  669. ASSERT(fingerprint.public # 0,101);
  670. *)
  671. fingerprint.deepAvailable := TRUE;
  672. x.SetFingerPrint(fingerprint);
  673. END;
  674. SELF.fingerprint := fingerprint;
  675. IF Trace THEN TraceExit("Record",fingerprint); END;
  676. END VisitRecordType;
  677. (*
  678. FP(ProcedureType) = fpTypeProcedure <*> fpTypeBasic [<*> fpDelegate]-> Name.
  679. PublicFP(ProcedureType) = FP(arrayType) -> Signature(procedureType)
  680. PrivateFP(ProcedureType) = FP(arrayType)-> Signature(procedureType).
  681. *)
  682. PROCEDURE VisitProcedureType(x: SyntaxTree.ProcedureType);
  683. VAR fingerprint: FingerPrint; deep: BOOLEAN; fp: LONGINT;
  684. BEGIN
  685. IF Trace THEN TraceEnter("ProcedureType") END;
  686. fingerprint := x.fingerprint;
  687. deep := SELF.deep;
  688. IF ~fingerprint.shallowAvailable THEN
  689. fingerprint.shallowAvailable := TRUE; (*! to avoid circles, this is not fully clean - for paco *)
  690. fp := 0;
  691. FPNumber(fp,fpTypeProcedure);
  692. FPNumber(fp,fpTypeBasic);
  693. IF x.isDelegate THEN FPNumber(fp,fpDelegate) END;
  694. x.SetFingerPrint(fingerprint);
  695. TypeName(fp,x);
  696. fingerprint.public := fp; fingerprint.private := fp;
  697. fingerprint.shallow := fp;
  698. FPSignature(fp,x,FALSE);
  699. fingerprint.public := fp; fingerprint.private := fp;
  700. fingerprint.shallow := fp;
  701. fingerprint.deepAvailable := TRUE;
  702. x.SetFingerPrint(fingerprint);
  703. END;
  704. (*
  705. IF ~fingerprint.deepAvailable THEN
  706. SELF.deep := FALSE;
  707. FPSignature(fp,x,FALSE);
  708. SELF.deep := deep;
  709. fingerprint.public := fp; fingerprint.private := fp;
  710. fingerprint.shallow := fp;
  711. fingerprint.deepAvailable := TRUE;
  712. END;
  713. *)
  714. IF Trace THEN TraceExit("ProcedureType",fingerprint) END;
  715. SELF.fingerprint := fingerprint;
  716. END VisitProcedureType;
  717. (** values - used in constant symbols - effects in fingerprint modification of (object) global variable fp *)
  718. (* fp = fp & (fpTrue | fpFalse) *)
  719. PROCEDURE VisitBooleanValue(x: SyntaxTree.BooleanValue);
  720. BEGIN IF x.value THEN FPNumber(SELF.fp,fpTrue) ELSE FPNumber(SELF.fp,fpFalse) END
  721. END VisitBooleanValue;
  722. (* fp = fp & (HugeInt | Number) *)
  723. PROCEDURE VisitIntegerValue(x: SyntaxTree.IntegerValue);
  724. BEGIN IF x.type.sizeInBits = 64 THEN FPHugeInt(SELF.fp,x.hvalue) ELSE FPNumber(SELF.fp,x.value) END;
  725. END VisitIntegerValue;
  726. (* fp = fp & (HugeInt | Number) *)
  727. PROCEDURE VisitEnumerationValue(x: SyntaxTree.EnumerationValue);
  728. BEGIN FPNumber(SELF.fp,x.value)
  729. END VisitEnumerationValue;
  730. (* fp = fp & ORD(char) *)
  731. PROCEDURE VisitCharacterValue(x: SyntaxTree.CharacterValue);
  732. BEGIN FPNumber(SELF.fp,ORD(x.value)) END VisitCharacterValue;
  733. (* fp = fp & Set *)
  734. PROCEDURE VisitSetValue(x: SyntaxTree.SetValue);
  735. BEGIN FPSet(SELF.fp,x.value) END VisitSetValue;
  736. PROCEDURE VisitMathArrayExpression(x: SyntaxTree.MathArrayExpression);
  737. VAR element: SyntaxTree.Expression; i: LONGINT;
  738. BEGIN
  739. FOR i := 0 TO x.elements.Length()-1 DO
  740. element := x.elements.GetExpression(i);
  741. FPValue(fp, element);
  742. END;
  743. END VisitMathArrayExpression;
  744. (* fp = fp {& Value} *)
  745. PROCEDURE VisitMathArrayValue(x: SyntaxTree.MathArrayValue);
  746. BEGIN
  747. VisitMathArrayExpression(x.array); (* do not call FPValue here, recursion possible because x.array.resolved = x *)
  748. END VisitMathArrayValue;
  749. (* fp = fp & (Real | LongReal) *)
  750. PROCEDURE VisitRealValue(x: SyntaxTree.RealValue);
  751. BEGIN
  752. IF x.type.sizeInBits=32 THEN FPReal(SELF.fp,SHORT(x.value))
  753. ELSE FPLongReal(SELF.fp,x.value)
  754. END;
  755. END VisitRealValue;
  756. PROCEDURE VisitNilValue(x: SyntaxTree.NilValue);
  757. BEGIN IF x.type.sizeInBits = 64 THEN FPHugeInt(SELF.fp, 0) ELSE FPNumber(SELF.fp, 0) END;
  758. END VisitNilValue;
  759. (* fp = fp & String *)
  760. PROCEDURE VisitStringValue(x: SyntaxTree.StringValue);
  761. BEGIN FPString(SELF.fp,x.value^) END VisitStringValue;
  762. (* fp = fp & FP(x) *)
  763. PROCEDURE FPValue(VAR fp: LONGINT; x: SyntaxTree.Expression);
  764. BEGIN
  765. SELF.fp := fp;
  766. IF x.resolved # NIL THEN
  767. x.resolved.Accept(SELF);
  768. ELSE
  769. x.Accept(SELF)
  770. END;
  771. fp := SELF.fp
  772. END FPValue;
  773. PROCEDURE FPType(VAR fp: LONGINT; t: SyntaxTree.Type);
  774. BEGIN
  775. INC(level); ASSERT(level <= 100);
  776. IF t = NIL THEN FPNumber(fp,fpTypeNone);
  777. ELSE t.Accept(SELF); FPNumber(fp,SELF.fingerprint.shallow);
  778. END;
  779. DEC(level);
  780. END FPType;
  781. (* Signature(f) = f <*> FP(returnType)
  782. { <*> (fpModeVarParameter | fpModeConstParameter | fpModePar)
  783. <*> FP(parameterType) [-> Name(parameterName)] }
  784. *)
  785. PROCEDURE FPSignature(VAR fp: LONGINT; t: SyntaxTree.ProcedureType; isOperator: BOOLEAN);
  786. VAR par,self: SyntaxTree.Parameter; deep: BOOLEAN;
  787. (* fp = fp & (fpModeVarPar | fpModeConstPar | fpModePar) [ & Name ] *)
  788. PROCEDURE FPPar(VAR fp: LONGINT; par: SyntaxTree.Parameter);
  789. VAR deep: BOOLEAN;
  790. BEGIN
  791. IF par.kind = SyntaxTree.VarParameter THEN FPNumber(fp, fpModeVarPar)
  792. ELSIF par.kind = SyntaxTree.ConstParameter THEN
  793. IF (par.type.resolved IS SyntaxTree.ArrayType) OR (par.type.resolved IS SyntaxTree.RecordType) THEN (*! compatiblity with paco *)
  794. FPNumber(fp,fpModeVarPar)
  795. ELSE
  796. FPNumber(fp,fpModePar)
  797. END;
  798. ELSE FPNumber(fp, fpModePar) END;
  799. deep := SELF.deep;
  800. SELF.deep := FALSE;
  801. FPType(fp,par.type);
  802. SELF.deep := deep;
  803. IF isOperator & ~(par.type.resolved IS SyntaxTree.BasicType) & (par.type.resolved.typeDeclaration # NIL) THEN
  804. FPName(fp,par.type.resolved.typeDeclaration.name);
  805. (* D.Str("fp "); D.Str0(par.type.resolved.typeDeclaration.name.name); D.Ln;*)
  806. ELSIF isOperator & (par.type.resolved IS SyntaxTree.BasicType) THEN
  807. FPName(fp,par.type.resolved(SyntaxTree.BasicType).name);
  808. (* D.Str("fpb "); D.Str0(par.type.resolved(SyntaxTree.BasicType).name.name);*)
  809. END;
  810. END FPPar;
  811. BEGIN
  812. IF Trace THEN
  813. TraceIndent; D.Str("FPSignature enter "); D.Hex(fp,-8); D.Ln;
  814. END;
  815. deep := SELF.deep;
  816. SELF.deep := FALSE;
  817. FPType(fp,t.returnType);
  818. SELF.deep := deep;
  819. IF Trace THEN
  820. TraceIndent; D.Str("FPSignature after return type "); D.Hex(fp,-8); D.Ln;
  821. END;
  822. IF IsOberonProcedure(t) THEN
  823. self := t.firstParameter;
  824. WHILE (self # NIL) & (self.name#Global.SelfParameterName) DO
  825. self := self.nextParameter;
  826. END;
  827. IF self # NIL THEN FPPar(fp,self) END; (* self parameter *)
  828. (*
  829. IF t.selfParameter # NIL THEN FPPar(fp,t.selfParameter) END; (* self parameter *)
  830. self := NIL;
  831. *)
  832. IF Trace THEN
  833. TraceIndent; D.Str("FPSignature after self "); D.Hex(fp,-8); D.Ln;
  834. END;
  835. par := t.firstParameter;
  836. WHILE (par#self) DO (*! done as in PACO *)
  837. FPPar(fp, par);
  838. IF Trace THEN
  839. TraceIndent; D.Str("FPSignature par "); D.Hex(fp,-8); D.Ln;
  840. END;
  841. par:=par.nextParameter;
  842. END;
  843. IF Trace THEN
  844. TraceIndent; D.Str("FPSignature exit "); D.Hex(fp,-8); D.Ln;
  845. END;
  846. ELSE
  847. par := t.lastParameter;
  848. WHILE (par#NIL) DO (*! done as in PACO *)
  849. FPPar(fp, par);
  850. IF Trace THEN
  851. TraceIndent; D.Str("FPSignature par "); D.Hex(fp,-8); D.Ln;
  852. END;
  853. par:=par.prevParameter;
  854. END;
  855. END;
  856. END FPSignature;
  857. (** symbols *)
  858. (*
  859. FP(TypeDeclaration) = 0 <*> fpModeType -> Name -> Visibility <*> FP(Type).
  860. *)
  861. PROCEDURE VisitTypeDeclaration(x: SyntaxTree.TypeDeclaration);
  862. VAR fp: LONGINT;
  863. fingerprint: FingerPrint; deep: BOOLEAN;
  864. typeFP: FingerPrint;
  865. BEGIN
  866. fingerprint := x.fingerprint;
  867. IF ~fingerprint.shallowAvailable THEN
  868. IF Trace THEN TraceEnter("TypeDeclaration") END;
  869. deep := SELF.deep;
  870. SELF.deep := FALSE;
  871. fp := 0;
  872. FPNumber(fp, fpModeType);
  873. FPName(fp,x.name);
  874. IF Trace THEN TraceIndent; D.String("access="); D.Set(x.access); D.Ln; END;
  875. FPVisibility(fp, x.access);
  876. x.declaredType.Accept(SELF);
  877. FPNumber(fp, SELF.fingerprint.shallow);
  878. fingerprint.shallow := fp;
  879. fingerprint.public := fp;
  880. fingerprint.private := fp;
  881. fingerprint.shallowAvailable := TRUE;
  882. x.SetFingerPrint(fingerprint);
  883. SELF.deep := deep;
  884. IF Trace THEN TraceExit("TypeDeclaration",fingerprint) END;
  885. END;
  886. IF deep & ~fingerprint.deepAvailable THEN
  887. fingerprint := x.fingerprint;
  888. typeFP := TypeFP(x.declaredType);
  889. IF x.declaredType.resolved IS SyntaxTree.PointerType THEN
  890. typeFP := TypeFP(x.declaredType.resolved(SyntaxTree.PointerType).pointerBase);
  891. END;
  892. FPNumber(fingerprint.public, typeFP.public);
  893. FPNumber(fingerprint.private, typeFP.private);
  894. fingerprint.deepAvailable := TRUE;
  895. x.SetFingerPrint(fingerprint);
  896. END;
  897. SELF.fingerprint := fingerprint
  898. END VisitTypeDeclaration;
  899. (*
  900. FP(ConstantDeclaration) = 0 <*> fpModeConstant -> Name -> Visibility <*> FP(Type) -> Basic -> Value.
  901. *)
  902. PROCEDURE VisitConstant(x: SyntaxTree.Constant);
  903. VAR access: SET;
  904. fingerprint: FingerPrint;
  905. fp: LONGINT;
  906. deep: BOOLEAN;
  907. BEGIN
  908. fingerprint := x.fingerprint;
  909. IF ~fingerprint.shallowAvailable THEN
  910. deep := SELF.deep;
  911. SELF.deep := FALSE;
  912. fp := 0;
  913. FPNumber(fp, fpModeConst);
  914. FPName(fp,x.name);
  915. (* for compatibility with old compiler: *)
  916. access := x.access; IF SyntaxTree.PublicRead IN access THEN INCL(access,SyntaxTree.PublicWrite) END;
  917. FPVisibility(fp, access);
  918. FPType(fp, x.type);
  919. FPNumber(fp, fpTypeBasic);
  920. FPValue(fp, x.value);
  921. fingerprint.shallow := fp;
  922. fingerprint.public := fingerprint.shallow;
  923. fingerprint.private := fingerprint.shallow;
  924. fingerprint.shallowAvailable := TRUE;
  925. x.SetFingerPrint(fingerprint);
  926. SELF.deep := deep;
  927. END;
  928. SELF.fingerprint := fingerprint
  929. END VisitConstant;
  930. (*
  931. FP(VariableDeclaration) = 0 <*> fpModePar -> Name -> Visibility <*> FP(Type).
  932. *)
  933. PROCEDURE VisitVariable(x: SyntaxTree.Variable);
  934. VAR fingerprint: FingerPrint; deep: BOOLEAN; name: SyntaxTree.IdentifierString;
  935. BEGIN
  936. fingerprint := x.fingerprint;
  937. IF ~fingerprint.shallowAvailable THEN
  938. deep := SELF.deep;
  939. SELF.deep := FALSE;
  940. fp := 0;
  941. FPNumber(fp,fpModeVar);
  942. Global.GetSymbolName(x,name);
  943. FPString(fp,name);
  944. FPVisibility(fp,x.access);
  945. x.type.Accept(SELF);
  946. FPNumber(fp,SELF.fingerprint.shallow);
  947. fingerprint.shallow := fp;
  948. fingerprint.public := fingerprint.shallow;
  949. fingerprint.private := fingerprint.shallow;
  950. fingerprint.shallowAvailable := TRUE;
  951. x.SetFingerPrint(fingerprint);
  952. SELF.deep := deep;
  953. END;
  954. SELF.fingerprint := fingerprint
  955. END VisitVariable;
  956. PROCEDURE VisitProperty(x: SyntaxTree.Property);
  957. BEGIN
  958. VisitVariable(x);
  959. END VisitProperty;
  960. (*
  961. FP(ParameterDeclaration) = 0 <*> fpModePar -> Name -> Visibility <*> FP(Type).
  962. *)
  963. PROCEDURE VisitParameter(x: SyntaxTree.Parameter);
  964. VAR fingerprint: FingerPrint; deep: BOOLEAN; name: SyntaxTree.IdentifierString;
  965. BEGIN
  966. fingerprint := x.fingerprint;
  967. IF ~fingerprint.shallowAvailable THEN
  968. deep := SELF.deep;
  969. SELF.deep := FALSE;
  970. fp := 0;
  971. FPNumber(fp,fpModePar);
  972. Global.GetSymbolName(x,name);
  973. FPString(fp,name);
  974. FPVisibility(fp,x.access);
  975. x.type.Accept(SELF);
  976. FPNumber(fp,SELF.fingerprint.shallow);
  977. fingerprint.shallow := fp;
  978. fingerprint.public := fingerprint.shallow;
  979. fingerprint.private := fingerprint.shallow;
  980. fingerprint.shallowAvailable := TRUE;
  981. x.SetFingerPrint(fingerprint);
  982. SELF.deep := deep;
  983. END;
  984. SELF.fingerprint := fingerprint
  985. END VisitParameter;
  986. (*
  987. FP(ProcedureDeclaration) = 0 <*> fpModeInlineProcedure -> Name -> Visibility <*> FP(Type) -> Code.
  988. | 0 <*> fpModeExportedProcedure -> Name -> Visibility <*> FP(Type)
  989. *)
  990. PROCEDURE VisitProcedure(x: SyntaxTree.Procedure);
  991. VAR fp: LONGINT; access: SET; fingerprint: FingerPrint; deep: BOOLEAN; code: SyntaxTree.Code; i: LONGINT;
  992. size,value: LONGINT; name: ARRAY 256 OF CHAR;
  993. BEGIN
  994. IF x.scope IS SyntaxTree.RecordScope THEN (* method *)
  995. FPrintMethod(fp,fp,x,NIL);
  996. fingerprint := x.fingerprint;
  997. ELSE
  998. fingerprint := x.fingerprint;
  999. IF ~fingerprint.shallowAvailable THEN
  1000. deep := SELF.deep;
  1001. SELF.deep := FALSE;
  1002. (* for compatibility with old compiler: *)
  1003. access := x.access; IF SyntaxTree.PublicRead IN access THEN INCL(access,SyntaxTree.PublicWrite) END;
  1004. fp := 0;
  1005. IF x.isInline THEN
  1006. FPNumber(fp, fpModeInlineProcedure);
  1007. FPName(fp,x.name);
  1008. FPVisibility(fp, access);
  1009. FPSignature(fp,x.type(SyntaxTree.ProcedureType),x IS SyntaxTree.Operator);
  1010. IF (x.procedureScope.body # NIL) & (x.procedureScope.body.code # NIL) THEN
  1011. code := x.procedureScope.body.code;
  1012. IF code.inlineCode = NIL THEN
  1013. size := 0
  1014. ELSE
  1015. size := code.inlineCode.GetSize() DIV 8;
  1016. END;
  1017. FPNumber(fp,size);
  1018. FOR i := 0 TO size-1 DO
  1019. value := code.inlineCode.GetBits(i*8,8);
  1020. FPNumber(fp,value);
  1021. END;
  1022. END;
  1023. ELSE
  1024. FPNumber(fp, fpModeExportedProcedure);
  1025. Global.GetSymbolName(x,name);
  1026. FPString(fp,name);
  1027. FPVisibility(fp, access);
  1028. FPSignature(fp,x.type(SyntaxTree.ProcedureType),x IS SyntaxTree.Operator);
  1029. END;
  1030. fingerprint.shallow := fp;
  1031. fingerprint.public := fingerprint.shallow;
  1032. fingerprint.private := fingerprint.shallow;
  1033. fingerprint.shallowAvailable := TRUE;
  1034. x.SetFingerPrint(fingerprint);
  1035. SELF.deep := deep;
  1036. END;
  1037. END;
  1038. SELF.fingerprint := fingerprint
  1039. END VisitProcedure;
  1040. (* cf. Procedure *)
  1041. PROCEDURE VisitOperator(x: SyntaxTree.Operator);
  1042. BEGIN
  1043. VisitProcedure(x) (* same finger print as a procedure *)
  1044. END VisitOperator;
  1045. PROCEDURE VisitModule(x: SyntaxTree.Module);
  1046. VAR fingerprint, symbolFingerPrint: FingerPrint; deep: BOOLEAN; fp: LONGINT; symbol: SyntaxTree.Symbol; scope: SyntaxTree.ModuleScope;
  1047. BEGIN
  1048. fingerprint := x.fingerprint;
  1049. deep := SELF.deep;
  1050. IF Trace THEN TraceEnter("Record"); END;
  1051. IF ~fingerprint.shallowAvailable THEN
  1052. IF Trace THEN TraceIndent; D.Str("Module Enter Shallow "); D.Ln; END;
  1053. SELF.deep := FALSE;
  1054. fp := 0;
  1055. FPNumber(fp, fpTypeModule);
  1056. FPName(fp,x.name);
  1057. IF Trace THEN TraceIndent; D.Str("Module Name ");D.Hex(fp,-8); D.Ln; END;
  1058. fingerprint.shallow := fp;
  1059. fingerprint.public := fingerprint.shallow;
  1060. fingerprint.private := fingerprint.shallow;
  1061. fingerprint.shallowAvailable := TRUE;
  1062. x.SetFingerPrint(fingerprint);
  1063. SELF.deep := deep;
  1064. IF Trace THEN TraceIndent; D.Str("Module Shallow Done "); TraceFP(fingerprint); D.Ln; END;
  1065. END;
  1066. IF deep & ~fingerprint.deepAvailable THEN
  1067. IF Trace THEN TraceIndent; D.Str("Module Enter Deep "); D.Ln; END;
  1068. fingerprint.private := fingerprint.shallow;
  1069. fingerprint.public := fingerprint.shallow;
  1070. scope := x.moduleScope;
  1071. IF Trace THEN TraceIndent; D.Str("RecordType before methods"); TraceFP(fingerprint); D.Ln; END;
  1072. symbol := scope.firstSymbol;
  1073. WHILE symbol # NIL DO
  1074. IF symbol.access * SyntaxTree.Public # {} THEN
  1075. symbolFingerPrint := SymbolFP(symbol);
  1076. FPNumber(fingerprint.private,symbolFingerPrint.shallow);
  1077. FPNumber(fingerprint.public,symbolFingerPrint.shallow);
  1078. END;
  1079. symbol := symbol.nextSymbol;
  1080. END;
  1081. IF Trace THEN TraceIndent; D.Str("Module Exit Deep "); TraceFP(fingerprint); D.Ln; END;
  1082. (*
  1083. ASSERT(fingerprint.private # 0,100);
  1084. ASSERT(fingerprint.public # 0,101);
  1085. *)
  1086. fingerprint.deepAvailable := TRUE;
  1087. x.SetFingerPrint(fingerprint);
  1088. END;
  1089. SELF.fingerprint := fingerprint;
  1090. IF Trace THEN TraceExit("Record",fingerprint); END;
  1091. END VisitModule;
  1092. PROCEDURE VisitSymbol(x: SyntaxTree.Symbol);
  1093. BEGIN
  1094. fingerprint.shallow := 0;
  1095. fingerprint.public := fingerprint.shallow;
  1096. fingerprint.private := fingerprint.shallow;
  1097. fingerprint.shallowAvailable := TRUE;
  1098. x.SetFingerPrint(fingerprint);
  1099. END VisitSymbol;
  1100. PROCEDURE TraceIndent;
  1101. VAR i: LONGINT;
  1102. BEGIN
  1103. FOR i := 1 TO traceLevel DO D.Str(" "); END;
  1104. END TraceIndent;
  1105. PROCEDURE TraceEnter(CONST name: ARRAY OF CHAR);
  1106. BEGIN
  1107. INC(traceLevel); TraceIndent;
  1108. D.Str("Enter ");
  1109. D.Str(name);
  1110. D.Ln;
  1111. END TraceEnter;
  1112. PROCEDURE TraceExit(CONST name: ARRAY OF CHAR; fingerprint: FingerPrint);
  1113. BEGIN
  1114. TraceIndent; DEC(traceLevel);
  1115. D.Str("Exit "); D.Str(name); D.Str(" "); TraceFP(fingerprint); D.Ln;
  1116. END TraceExit;
  1117. PROCEDURE TraceFP(fingerprint: FingerPrint);
  1118. BEGIN
  1119. D.Hex(fingerprint.shallow,-8); D.Str(" "); D.Hex(fingerprint.private,-8);
  1120. D.Str(" "); D.Hex(fingerprint.public,-8);
  1121. END TraceFP;
  1122. (* returns the finger print (object) of a type *)
  1123. PROCEDURE TypeFP*(this: SyntaxTree.Type): FingerPrint;
  1124. VAR deep: BOOLEAN;
  1125. BEGIN
  1126. IF Trace THEN TraceEnter("TypeFP"); END;
  1127. deep := SELF.deep;
  1128. SELF.deep := TRUE;
  1129. this.Accept(SELF);
  1130. SELF.deep := deep;
  1131. ASSERT(fingerprint.deepAvailable,101);
  1132. ASSERT(fingerprint.shallow #0,102);
  1133. IF Trace THEN TraceExit("TypeFP",fingerprint); D.Ln;
  1134. D.Ln; END;
  1135. RETURN fingerprint
  1136. END TypeFP;
  1137. (* returns the finger print (object) of a symbol *)
  1138. PROCEDURE SymbolFP*(this: SyntaxTree.Symbol): FingerPrint;
  1139. VAR deep: BOOLEAN;
  1140. BEGIN
  1141. deep := SELF.deep;
  1142. SELF.deep := TRUE;
  1143. IF Trace THEN TraceEnter("SymbolFP");
  1144. TraceIndent;
  1145. D.Str("name: ");
  1146. D.Str0(this.name); D.Ln;
  1147. END;
  1148. this.Accept(SELF);
  1149. SELF.deep := deep;
  1150. IF Trace THEN TraceExit("SymbolFP",fingerprint); D.Ln; END;
  1151. RETURN fingerprint
  1152. END SymbolFP;
  1153. END FingerPrinter;
  1154. (** ---------- FingerPrinting primitives -------------- *)
  1155. PROCEDURE IsOberonProcedure(type: SyntaxTree.ProcedureType): BOOLEAN;
  1156. BEGIN
  1157. RETURN type.callingConvention = SyntaxTree.OberonCallingConvention
  1158. END IsOberonProcedure;
  1159. (* fp = fp <*> val *)
  1160. PROCEDURE FPNumber*(VAR fp: LONGINT; val: LONGINT);
  1161. BEGIN
  1162. fp:=SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, ROT(fp, 7)) / SYSTEM.VAL(SET, val))
  1163. END FPNumber;
  1164. (* fp = fp <*> set *)
  1165. PROCEDURE FPSet*(VAR fp: LONGINT; set: SET);
  1166. BEGIN FPNumber(fp, SYSTEM.VAL(LONGINT, set))
  1167. END FPSet;
  1168. (* fp = fp <*> real *)
  1169. PROCEDURE FPReal*(VAR fp: LONGINT; real: REAL);
  1170. BEGIN FPNumber(fp, SYSTEM.VAL(LONGINT, real))
  1171. END FPReal;
  1172. (* fp = fp <*> low <*> high *)
  1173. PROCEDURE FPLongReal*(VAR fp: LONGINT; lr: LONGREAL);
  1174. VAR l, h: LONGINT;
  1175. BEGIN
  1176. SYSTEM.GET(ADDRESSOF(lr)+4, l); SYSTEM.GET(ADDRESSOF(lr), h);
  1177. FPNumber(fp, l); FPNumber(fp, h);
  1178. END FPLongReal;
  1179. (* fp = fp <*> low <*> high *)
  1180. PROCEDURE FPHugeInt*(VAR fp: LONGINT; huge: HUGEINT);
  1181. VAR l, h: LONGINT;
  1182. BEGIN
  1183. SYSTEM.GET(ADDRESSOF(huge)+4, l); SYSTEM.GET(ADDRESSOF(huge), h);
  1184. FPNumber(fp, l); FPNumber(fp, h);
  1185. END FPHugeInt;
  1186. (* fp = fp -> String *)
  1187. PROCEDURE FPName*(VAR fp: LONGINT; x: SyntaxTree.Identifier);
  1188. VAR name: Scanner.IdentifierString;
  1189. BEGIN
  1190. Basic.GetString(x,name);
  1191. FPString(fp,name);
  1192. END FPName;
  1193. (* fp = fp {<*> str[i]} *)
  1194. PROCEDURE FPString*(VAR fp: LONGINT; CONST str: ARRAY OF CHAR);
  1195. VAR i: INTEGER; ch: CHAR;
  1196. BEGIN i:=0; REPEAT ch:=str[i]; FPNumber(fp, ORD(ch)); INC(i) UNTIL ch=0X
  1197. END FPString;
  1198. (* fp = fp <*> (fpExtern | fpExternR | fpIntern | fpOther + vis) *)
  1199. PROCEDURE FPVisibility*(VAR fp: LONGINT; vis: SET);
  1200. BEGIN
  1201. IF SyntaxTree.PublicWrite IN vis THEN FPNumber(fp, fpExtern)
  1202. ELSIF SyntaxTree.PublicRead IN vis THEN FPNumber(fp, fpExternR)
  1203. ELSIF SyntaxTree.Internal * vis #{} THEN FPNumber(fp, fpIntern)
  1204. ELSE
  1205. FPNumber(fp, fpOther + SYSTEM.VAL(LONGINT, vis))
  1206. END
  1207. END FPVisibility;
  1208. PROCEDURE DumpFingerPrint*(w: Streams.Writer; fp: FingerPrint);
  1209. BEGIN
  1210. w.String("fingerprint: ");
  1211. w.String("shallow = "); w.Hex(fp.shallow,8);
  1212. w.String(", private = "); w.Hex(fp.private,8);
  1213. w.String(", public = "); w.Hex(fp.public,8);
  1214. w.Ln;
  1215. END DumpFingerPrint;
  1216. END FoxFingerPrinter.