FoxFingerPrinter.Mod 43 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324
  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. x.SetFingerPrint(fingerprint);
  315. SELF.deep := deep;
  316. END;
  317. IF deep & ~fingerprint.deepAvailable THEN
  318. fingerprint.private := fingerprint.shallow;
  319. fingerprint.public := fingerprint.shallow;
  320. fingerprint.deepAvailable := TRUE; (* to avoid circles during base finger printing *)
  321. x.SetFingerPrint(fingerprint);
  322. x.arrayBase.Accept(SELF); (* make sure that base pointer is also deeply fped *)
  323. END;
  324. IF Trace THEN TraceExit("ArrayType",fingerprint) END;
  325. SELF.fingerprint := fingerprint;
  326. END VisitArrayType;
  327. (*
  328. FP(MathArrayType) = fpTypeComposite <*> (fpTypeOpenArray | fpTypeStaticArray)
  329. -> Name <*> FP(baseType) [<*> length].
  330. PublicFP(MathArrayType) = FP(arrayType).
  331. PrivateFP(MathArrayType) = FP(arrayType).
  332. *)
  333. PROCEDURE VisitMathArrayType(x: SyntaxTree.MathArrayType);
  334. VAR fingerprint: FingerPrint; deep: BOOLEAN; fp: LONGINT;
  335. BEGIN
  336. fingerprint := x.fingerprint;
  337. deep := SELF.deep;
  338. IF Trace THEN TraceEnter("MathArrayType") END;
  339. IF ~fingerprint.shallowAvailable THEN
  340. fingerprint.shallowAvailable := TRUE; (* the fingerprinting may return to itself => avoid circles *)
  341. SELF.deep := FALSE;
  342. fp := 0;
  343. FPNumber(fp,fpTypeComposite);
  344. IF x.form = SyntaxTree.Open THEN FPNumber(fp,fpTypeOpenArray)
  345. ELSIF x.form = SyntaxTree.Static THEN FPNumber(fp,fpTypeStaticArray)
  346. ELSIF x.form = SyntaxTree.Tensor THEN (* do nothing *)
  347. ELSE HALT(200)
  348. END;
  349. TypeName(fp,x);
  350. IF x.arrayBase # NIL THEN
  351. FPType(fp,x.arrayBase.resolved);
  352. END;
  353. IF x.form = SyntaxTree.Static THEN FPNumber(fp,x.staticLength) END;
  354. fingerprint.shallow := fp;
  355. fingerprint.shallowAvailable := TRUE;
  356. x.SetFingerPrint(fingerprint);
  357. SELF.deep := deep;
  358. END;
  359. IF deep & ~fingerprint.deepAvailable THEN
  360. x.arrayBase.Accept(SELF);
  361. fingerprint.private := fingerprint.shallow;
  362. fingerprint.public := fingerprint.shallow;
  363. fingerprint.deepAvailable := TRUE;
  364. x.SetFingerPrint(fingerprint);
  365. END;
  366. IF Trace THEN TraceExit("MathArrayType",fingerprint) END;
  367. SELF.fingerprint := fingerprint;
  368. END VisitMathArrayType;
  369. (*
  370. fp = fp [ -> Name(moduleName) -> Name(typeName) ]
  371. *)
  372. PROCEDURE TypeName(VAR fp: LONGINT; x:SyntaxTree.Type);
  373. VAR typeDeclaration: SyntaxTree.TypeDeclaration;
  374. BEGIN
  375. IF (x.scope # NIL) THEN
  376. (* only executed for imported types, reason:
  377. modification of a type name would result in modified fingerprint leading to modified fingerprints of using structures such as
  378. in the following example:
  379. TYPE A=ARRAY 32 OF CHAR;
  380. PROCEDURE P*(a:A);
  381. ...
  382. END P;
  383. IF name of A was changed, P would get a new fingerprint.
  384. Better: fingerprint of P only depends in type of A but not on its declared name.
  385. *)
  386. IF Trace THEN
  387. TraceIndent;
  388. D.Str("TypeName ");
  389. D.Str0(x.scope.ownerModule.name);
  390. END;
  391. typeDeclaration := x.typeDeclaration;
  392. IF(typeDeclaration # NIL) & (typeDeclaration.access * SyntaxTree.Public # {}) THEN
  393. FPName(fp,x.scope.ownerModule.name);
  394. IF (typeDeclaration.declaredType.resolved # x) THEN
  395. (* in record type: pointer to type declaration of a pointer *)
  396. typeDeclaration := NIL
  397. END;
  398. IF (typeDeclaration # NIL) & (typeDeclaration.scope # NIL)THEN
  399. FPName(fp,typeDeclaration.name);
  400. IF Trace THEN
  401. D.Str(".");
  402. D.Str0(typeDeclaration.name);
  403. END;
  404. ELSIF (typeDeclaration # NIL) & (typeDeclaration.scope = NIL) THEN
  405. D.Str("typedeclaration without scope: "); D.Str0(x.typeDeclaration.name); D.Int(x.typeDeclaration.position.start,5); D.Ln;
  406. D.Update;
  407. ELSE
  408. FPNumber(fp,0);
  409. END;
  410. ELSE
  411. FPNumber(fp, 0);
  412. END;
  413. IF Trace THEN
  414. D.Str(", fp = "); D.Hex(fp,-8); D.Ln;
  415. END
  416. END
  417. END TypeName;
  418. (*
  419. FP(PointerType) = fpTypePointer <*> fpTypeBasic -> Name <*> FP(baseType).
  420. PublicFP(PointerType) = 0.
  421. PrivateFP(PointerType) = 0.
  422. *)
  423. PROCEDURE VisitPointerType(x: SyntaxTree.PointerType);
  424. VAR fingerprint: FingerPrint; fp: LONGINT; deep: BOOLEAN;
  425. BEGIN
  426. IF Trace THEN TraceEnter("PointerType"); END;
  427. fingerprint := x.fingerprint;
  428. deep := SELF.deep;
  429. IF ~fingerprint.shallowAvailable THEN
  430. IF Trace THEN TraceIndent; D.Str("PointerType shallow");D.Ln; END;
  431. SELF.deep := FALSE;
  432. fp := 0;
  433. FPNumber(fp, fpTypePointer); FPNumber(fp, fpTypeBasic);
  434. TypeName(fp,x);
  435. FPType(fp,x.pointerBase);
  436. fingerprint.shallow := fp;
  437. fingerprint.private := fp;
  438. fingerprint.public := fp;
  439. fingerprint.shallowAvailable := TRUE;
  440. fingerprint.deepAvailable := TRUE;
  441. (*
  442. deep fingerprinting leads to cycles -> must be done on record type directly, if a deep FP is needed
  443. IF deep & ~fingerprint.deepAvailable THEN
  444. IF Trace THEN TraceIndent; D.Str("PointerType:deep");D.Ln; END;
  445. x.pointerBase.Accept(SELF);
  446. fingerprint.deepAvailable := TRUE;
  447. END;
  448. *)
  449. SELF.deep := deep;
  450. END;
  451. IF Trace THEN TraceExit("PointerType",fingerprint) END;
  452. SELF.fingerprint := fingerprint;
  453. END VisitPointerType;
  454. (*
  455. FP(PortType) = fpTypePort <*> fpTypeBasic -> Name <*> FP(baseType).
  456. PublicFP(PortType) = 0.
  457. PrivateFP(PortType) = 0.
  458. *)
  459. PROCEDURE VisitPortType(x: SyntaxTree.PortType);
  460. VAR fingerprint: FingerPrint; fp: LONGINT; deep: BOOLEAN;
  461. BEGIN
  462. IF Trace THEN TraceEnter("PortType"); END;
  463. fingerprint := x.fingerprint;
  464. deep := SELF.deep;
  465. IF ~fingerprint.shallowAvailable THEN
  466. IF Trace THEN TraceIndent; D.Str("PortType shallow");D.Ln; END;
  467. SELF.deep := FALSE;
  468. fp := 0;
  469. FPNumber(fp, fpTypePort); FPNumber(fp, fpTypeBasic);
  470. TypeName(fp,x);
  471. FPNumber(fp,x.sizeInBits);
  472. fingerprint.shallow := fp;
  473. fingerprint.private := fp;
  474. fingerprint.public := fp;
  475. fingerprint.shallowAvailable := TRUE;
  476. fingerprint.deepAvailable := TRUE;
  477. SELF.deep := deep;
  478. END;
  479. IF Trace THEN TraceExit("PortType",fingerprint) END;
  480. SELF.fingerprint := fingerprint;
  481. END VisitPortType;
  482. (*
  483. FP(Method) = 0 <*> fpModeMethod -> Name(methodName) -> Signature(method).
  484. *)
  485. PROCEDURE FPrintMethod(VAR private,public: LONGINT; procedure,body: SyntaxTree.Procedure);
  486. VAR fingerprint: FingerPrint; fp: LONGINT; name: ARRAY 256 OF CHAR;
  487. BEGIN
  488. IF Trace THEN TraceEnter("Method");
  489. D.Address(SYSTEM.VAL(ADDRESS,procedure));
  490. procedure.GetName(name);
  491. TraceIndent; D.Str("name = "); D.Str(name); D.Ln;
  492. END;
  493. ASSERT(deep);
  494. fingerprint := procedure.fingerprint;
  495. IF ~fingerprint.shallowAvailable THEN
  496. fp := 0;
  497. FPNumber(fp,fpModeMethod);
  498. Global.GetSymbolName(procedure,name);
  499. FPString(fp,name);
  500. FPSignature(fp,procedure.type(SyntaxTree.ProcedureType),procedure IS SyntaxTree.Operator );
  501. fingerprint.shallow := fp;
  502. fingerprint.shallowAvailable := TRUE;
  503. procedure.SetFingerPrint(fingerprint)
  504. ELSE
  505. fp := fingerprint.shallow;
  506. END;
  507. IF procedure.access * SyntaxTree.Public # {} THEN (* visible method or visible supermethod *)
  508. IF Trace THEN D.String("fp before method number"); D.Hex(fp,-8); D.Ln END;
  509. FPNumber(fp,procedure.methodNumber);
  510. IF Trace THEN D.String("fp after method number"); D.Hex(fp,-8); D.Ln END;
  511. IF procedure # body THEN
  512. FPNumber(private,fp); FPNumber(public,fp);
  513. END;
  514. END;
  515. IF Trace THEN
  516. TraceIndent; D.Str("Method, fp = "); D.Hex(private,-8); D.Str(" "); D.Hex(public,-8); D.Ln;
  517. TraceExit("Method",fingerprint)
  518. END;
  519. END FPrintMethod;
  520. PROCEDURE VisitCellType(x: SyntaxTree.CellType);
  521. VAR fingerprint: FingerPrint; fp:LONGINT; name: SyntaxTree.String;
  522. BEGIN
  523. fingerprint := x.fingerprint;
  524. deep := SELF.deep;
  525. IF ~fingerprint.shallowAvailable THEN
  526. fp := 0;
  527. TypeName(fp,x);
  528. fingerprint.shallow := fp;
  529. fingerprint.public := fp;
  530. fingerprint.private := fp;
  531. fingerprint.deepAvailable := TRUE;
  532. fingerprint.shallowAvailable := TRUE;
  533. x.SetFingerPrint(fingerprint);
  534. END;
  535. SELF.fingerprint := fingerprint
  536. END VisitCellType;
  537. (*
  538. FP(RecordType) = fpTypeComposite <*> fptypeRecord
  539. [ -> Name(moduleName) -> Name(typeName)] [<*> FP(baseType)]
  540. PublicFP(RecordType) = FP(recordType) [<*> PublicFP(baseType)] {<*> FP(method) <*> methodNumber }
  541. {<*> PublicFP(fieldType) <*> offset(field) <*> FP(field)} <*> flags.
  542. PrivateFP(RecordType) = FP(recordType) [<*> PrivateFP(baseType)] {<*> FP(method) <*> methodNumber }
  543. {<*> PrivateFP(fieldType) <*> offset(field) <*> FP(field)}
  544. *)
  545. PROCEDURE VisitRecordType(x: SyntaxTree.RecordType);
  546. VAR scope: SyntaxTree.RecordScope; fp: LONGINT; variable: SyntaxTree.Variable;
  547. fingerprint,variableFingerPrint,variableTypeFingerPrint,baseFingerPrint: FingerPrint;flags: SET;
  548. symbol: SyntaxTree.Symbol; procedure: SyntaxTree.Procedure; baseType: SyntaxTree.Type;
  549. body: SyntaxTree.Body;
  550. deep: BOOLEAN;
  551. (* for dealing with cycles the private and public fingerprint are computed here
  552. while FP is computed completely during call of Type0 *)
  553. BEGIN
  554. fingerprint := x.fingerprint;
  555. deep := SELF.deep;
  556. IF Trace THEN TraceEnter("Record"); END;
  557. IF ~fingerprint.shallowAvailable THEN
  558. IF Trace THEN TraceIndent; D.Str("RecordType Enter Shallow "); D.Ln; END;
  559. SELF.deep := FALSE;
  560. fp := 0;
  561. FPNumber(fp, fpTypeComposite); FPNumber(fp, fpTypeRecord);
  562. TypeName(fp,x);
  563. IF Trace THEN TraceIndent; D.Str("RecordType Name ");D.Hex(fp,-8); D.Ln; END;
  564. IF (x.baseType # NIL) THEN
  565. baseType := x.GetBaseRecord();
  566. FPType(fp,baseType);
  567. END;
  568. fingerprint.shallow := fp;
  569. fingerprint.shallowAvailable := TRUE;
  570. x.SetFingerPrint(fingerprint);
  571. SELF.deep := deep;
  572. IF Trace THEN TraceIndent; D.Str("RecordType Shallow Done "); TraceFP(fingerprint); D.Ln; END;
  573. END;
  574. IF deep & ~fingerprint.deepAvailable THEN
  575. IF Trace THEN TraceIndent; D.Str("RecordType Enter Deep "); D.Ln; END;
  576. fingerprint.private := fingerprint.shallow;
  577. fingerprint.public := fingerprint.shallow;
  578. (*! finger printing for interfaces omitted *)
  579. IF Trace THEN TraceIndent; D.Str("RecordType before basetype"); TraceFP(fingerprint); D.Ln; END;
  580. (* now compute base record finger prints *)
  581. baseType := x.GetBaseRecord();
  582. IF (baseType # NIL) THEN
  583. IF baseType IS SyntaxTree.PointerType THEN baseType := baseType(SyntaxTree.PointerType).pointerBase.resolved END;
  584. baseFingerPrint := TypeFP(baseType); (* deep finger print *)
  585. FPNumber(fingerprint.private,baseFingerPrint.private);
  586. FPNumber(fingerprint.public,baseFingerPrint.public);
  587. END;
  588. scope := x.recordScope;
  589. IF Trace THEN TraceIndent; D.Str("RecordType before methods"); TraceFP(fingerprint); D.Ln; END;
  590. (* methods, sorted *)
  591. symbol := scope.firstSymbol;
  592. WHILE symbol # NIL DO
  593. IF symbol IS SyntaxTree.Procedure THEN
  594. procedure := symbol(SyntaxTree.Procedure);
  595. FPrintMethod(fingerprint.private, fingerprint.public, procedure, scope.bodyProcedure);
  596. IF Trace THEN TraceIndent; D.Str("RecordType Method "); TraceFP(fingerprint); D.Ln; END;
  597. END;
  598. symbol := symbol.nextSymbol
  599. END;
  600. IF Trace THEN TraceIndent; D.Str("RecordType after methods"); TraceFP(fingerprint); D.Ln; END;
  601. variable := scope.firstVariable;
  602. WHILE variable # NIL DO
  603. variableFingerPrint := variable.fingerprint;
  604. IF variable.access * SyntaxTree.Public # {} THEN
  605. (* variable fp = & fpModeField & Name & Visibility [& fpUntraced] & Type *)
  606. fp := 0;
  607. FPNumber(fp,fpModeField);
  608. FPName(fp,variable.name);
  609. FPVisibility(fp,variable.access);
  610. IF variable.untraced THEN FPNumber(fp,fpUntraced) END;
  611. variableTypeFingerPrint := TypeFP(variable.type); (* deep finger print *)
  612. FPNumber(fp,variableTypeFingerPrint.shallow);
  613. variableFingerPrint.shallow := fp;
  614. FPNumber(fingerprint.private,variableTypeFingerPrint.private);
  615. FPNumber(fingerprint.private,SHORT(variable.offsetInBits DIV 8));
  616. FPNumber(fingerprint.private,fp);
  617. FPNumber(fingerprint.public,variableTypeFingerPrint.public);
  618. FPNumber(fingerprint.public,SHORT(variable.offsetInBits DIV 8));
  619. FPNumber(fingerprint.public,fp);
  620. IF Trace THEN TraceIndent; D.Str("RecordType Field "); D.Str0(variable.name); D.Str(" "); TraceFP(fingerprint); D.Ln; END;
  621. ELSE
  622. fp := 0;
  623. IF variable.untraced THEN FPNumber(fp,fpUntraced) END;
  624. FPNumber(fingerprint.private,fp);
  625. IF Trace THEN TraceIndent; D.Str("RecordType InvisibleField "); TraceFP(fingerprint); D.Ln; END;
  626. END;
  627. variable := variable.nextVariable;
  628. END;
  629. flags := {};
  630. IF x.recordScope.bodyProcedure # NIL THEN
  631. body := x.recordScope.bodyProcedure.procedureScope.body;
  632. INCL(flags, fpHasBody);
  633. IF body # NIL THEN
  634. IF body.isActive THEN INCL(flags,fpActive) END;
  635. IF body.isExclusive THEN INCL(flags,fpProtected) END;
  636. END;
  637. IF Trace THEN TraceIndent; D.Str("RecordType Body "); TraceFP(fingerprint); D.Ln; END;
  638. END;
  639. IF x.IsProtected() THEN INCL(flags,fpProtected) END;
  640. FPSet(fingerprint.public, flags);
  641. IF Trace THEN TraceIndent; D.Str("RecordType Exit Deep "); TraceFP(fingerprint); D.Ln; END;
  642. (*
  643. ASSERT(fingerprint.private # 0,100);
  644. ASSERT(fingerprint.public # 0,101);
  645. *)
  646. fingerprint.deepAvailable := TRUE;
  647. x.SetFingerPrint(fingerprint);
  648. END;
  649. SELF.fingerprint := fingerprint;
  650. IF Trace THEN TraceExit("Record",fingerprint); END;
  651. END VisitRecordType;
  652. (*
  653. FP(ProcedureType) = fpTypeProcedure <*> fpTypeBasic [<*> fpDelegate]-> Name.
  654. PublicFP(ProcedureType) = FP(arrayType) -> Signature(procedureType)
  655. PrivateFP(ProcedureType) = FP(arrayType)-> Signature(procedureType).
  656. *)
  657. PROCEDURE VisitProcedureType(x: SyntaxTree.ProcedureType);
  658. VAR fingerprint: FingerPrint; deep: BOOLEAN; fp: LONGINT;
  659. BEGIN
  660. IF Trace THEN TraceEnter("ProcedureType") END;
  661. fingerprint := x.fingerprint;
  662. deep := SELF.deep;
  663. IF ~fingerprint.shallowAvailable THEN
  664. fingerprint.shallowAvailable := TRUE; (*! to avoid circles, this is not fully clean - for paco *)
  665. fp := 0;
  666. FPNumber(fp,fpTypeProcedure);
  667. FPNumber(fp,fpTypeBasic);
  668. IF x.isDelegate THEN FPNumber(fp,fpDelegate) END;
  669. x.SetFingerPrint(fingerprint);
  670. TypeName(fp,x);
  671. fingerprint.public := fp; fingerprint.private := fp;
  672. fingerprint.shallow := fp;
  673. FPSignature(fp,x,FALSE);
  674. fingerprint.public := fp; fingerprint.private := fp;
  675. fingerprint.shallow := fp;
  676. fingerprint.deepAvailable := TRUE;
  677. x.SetFingerPrint(fingerprint);
  678. END;
  679. (*
  680. IF ~fingerprint.deepAvailable THEN
  681. SELF.deep := FALSE;
  682. FPSignature(fp,x,FALSE);
  683. SELF.deep := deep;
  684. fingerprint.public := fp; fingerprint.private := fp;
  685. fingerprint.shallow := fp;
  686. fingerprint.deepAvailable := TRUE;
  687. END;
  688. *)
  689. IF Trace THEN TraceExit("ProcedureType",fingerprint) END;
  690. SELF.fingerprint := fingerprint;
  691. END VisitProcedureType;
  692. (** values - used in constant symbols - effects in fingerprint modification of (object) global variable fp *)
  693. (* fp = fp & (fpTrue | fpFalse) *)
  694. PROCEDURE VisitBooleanValue(x: SyntaxTree.BooleanValue);
  695. BEGIN IF x.value THEN FPNumber(SELF.fp,fpTrue) ELSE FPNumber(SELF.fp,fpFalse) END
  696. END VisitBooleanValue;
  697. (* fp = fp & (HugeInt | Number) *)
  698. PROCEDURE VisitIntegerValue(x: SyntaxTree.IntegerValue);
  699. BEGIN IF x.type.sizeInBits = 64 THEN FPHugeInt(SELF.fp,x.hvalue) ELSE FPNumber(SELF.fp,x.value) END;
  700. END VisitIntegerValue;
  701. (* fp = fp & (HugeInt | Number) *)
  702. PROCEDURE VisitEnumerationValue(x: SyntaxTree.EnumerationValue);
  703. BEGIN FPNumber(SELF.fp,x.value)
  704. END VisitEnumerationValue;
  705. (* fp = fp & ORD(char) *)
  706. PROCEDURE VisitCharacterValue(x: SyntaxTree.CharacterValue);
  707. BEGIN FPNumber(SELF.fp,ORD(x.value)) END VisitCharacterValue;
  708. (* fp = fp & Set *)
  709. PROCEDURE VisitSetValue(x: SyntaxTree.SetValue);
  710. BEGIN FPSet(SELF.fp,x.value) END VisitSetValue;
  711. PROCEDURE VisitMathArrayExpression(x: SyntaxTree.MathArrayExpression);
  712. VAR element: SyntaxTree.Expression; i: LONGINT;
  713. BEGIN
  714. FOR i := 0 TO x.elements.Length()-1 DO
  715. element := x.elements.GetExpression(i);
  716. FPValue(fp, element);
  717. END;
  718. END VisitMathArrayExpression;
  719. (* fp = fp {& Value} *)
  720. PROCEDURE VisitMathArrayValue(x: SyntaxTree.MathArrayValue);
  721. BEGIN
  722. VisitMathArrayExpression(x.array); (* do not call FPValue here, recursion possible because x.array.resolved = x *)
  723. END VisitMathArrayValue;
  724. (* fp = fp & (Real | LongReal) *)
  725. PROCEDURE VisitRealValue(x: SyntaxTree.RealValue);
  726. BEGIN
  727. IF x.type.sizeInBits=32 THEN FPReal(SELF.fp,SHORT(x.value))
  728. ELSE FPLongReal(SELF.fp,x.value)
  729. END;
  730. END VisitRealValue;
  731. PROCEDURE VisitNilValue(x: SyntaxTree.NilValue);
  732. BEGIN IF x.type.sizeInBits = 64 THEN FPHugeInt(SELF.fp, 0) ELSE FPNumber(SELF.fp, 0) END;
  733. END VisitNilValue;
  734. (* fp = fp & String *)
  735. PROCEDURE VisitStringValue(x: SyntaxTree.StringValue);
  736. BEGIN FPString(SELF.fp,x.value^) END VisitStringValue;
  737. (* fp = fp & FP(x) *)
  738. PROCEDURE FPValue(VAR fp: LONGINT; x: SyntaxTree.Expression);
  739. BEGIN
  740. SELF.fp := fp;
  741. IF x.resolved # NIL THEN
  742. x.resolved.Accept(SELF);
  743. ELSE
  744. x.Accept(SELF)
  745. END;
  746. fp := SELF.fp
  747. END FPValue;
  748. PROCEDURE FPType(VAR fp: LONGINT; t: SyntaxTree.Type);
  749. BEGIN
  750. INC(level); ASSERT(level <= 100);
  751. IF t = NIL THEN FPNumber(fp,fpTypeNone);
  752. ELSE t.Accept(SELF); FPNumber(fp,SELF.fingerprint.shallow);
  753. END;
  754. DEC(level);
  755. END FPType;
  756. (* Signature(f) = f <*> FP(returnType)
  757. { <*> (fpModeVarParameter | fpModeConstParameter | fpModePar)
  758. <*> FP(parameterType) [-> Name(parameterName)] }
  759. *)
  760. PROCEDURE FPSignature(VAR fp: LONGINT; t: SyntaxTree.ProcedureType; isOperator: BOOLEAN);
  761. VAR par,self: SyntaxTree.Parameter;
  762. (* fp = fp & (fpModeVarPar | fpModeConstPar | fpModePar) [ & Name ] *)
  763. PROCEDURE FPPar(VAR fp: LONGINT; par: SyntaxTree.Parameter);
  764. VAR deep: BOOLEAN;
  765. BEGIN
  766. IF par.kind = SyntaxTree.VarParameter THEN FPNumber(fp, fpModeVarPar)
  767. ELSIF par.kind = SyntaxTree.ConstParameter THEN
  768. IF (par.type.resolved IS SyntaxTree.ArrayType) OR (par.type.resolved IS SyntaxTree.RecordType) THEN (*! compatiblity with paco *)
  769. FPNumber(fp,fpModeVarPar)
  770. ELSE
  771. FPNumber(fp,fpModePar)
  772. END;
  773. ELSE FPNumber(fp, fpModePar) END;
  774. deep := SELF.deep;
  775. SELF.deep := FALSE;
  776. FPType(fp,par.type);
  777. SELF.deep := deep;
  778. IF isOperator & ~(par.type.resolved IS SyntaxTree.BasicType) & (par.type.resolved.typeDeclaration # NIL) THEN
  779. FPName(fp,par.type.resolved.typeDeclaration.name);
  780. (* D.Str("fp "); D.Str0(par.type.resolved.typeDeclaration.name.name); D.Ln;*)
  781. ELSIF isOperator & (par.type.resolved IS SyntaxTree.BasicType) THEN
  782. FPName(fp,par.type.resolved(SyntaxTree.BasicType).name);
  783. (* D.Str("fpb "); D.Str0(par.type.resolved(SyntaxTree.BasicType).name.name);*)
  784. END;
  785. END FPPar;
  786. BEGIN
  787. IF Trace THEN
  788. TraceIndent; D.Str("FPSignature enter "); D.Hex(fp,-8); D.Ln;
  789. END;
  790. FPType(fp,t.returnType);
  791. IF Trace THEN
  792. TraceIndent; D.Str("FPSignature after return type "); D.Hex(fp,-8); D.Ln;
  793. END;
  794. IF IsOberonProcedure(t) THEN
  795. self := t.firstParameter;
  796. WHILE (self # NIL) & (self.name#Global.SelfParameterName) DO
  797. self := self.nextParameter;
  798. END;
  799. IF self # NIL THEN FPPar(fp,self) END; (* self parameter *)
  800. (*
  801. IF t.selfParameter # NIL THEN FPPar(fp,t.selfParameter) END; (* self parameter *)
  802. self := NIL;
  803. *)
  804. IF Trace THEN
  805. TraceIndent; D.Str("FPSignature after self "); D.Hex(fp,-8); D.Ln;
  806. END;
  807. par := t.firstParameter;
  808. WHILE (par#self) DO (*! done as in PACO *)
  809. FPPar(fp, par);
  810. IF Trace THEN
  811. TraceIndent; D.Str("FPSignature par "); D.Hex(fp,-8); D.Ln;
  812. END;
  813. par:=par.nextParameter;
  814. END;
  815. IF Trace THEN
  816. TraceIndent; D.Str("FPSignature exit "); D.Hex(fp,-8); D.Ln;
  817. END;
  818. ELSE
  819. par := t.lastParameter;
  820. WHILE (par#NIL) DO (*! done as in PACO *)
  821. FPPar(fp, par);
  822. IF Trace THEN
  823. TraceIndent; D.Str("FPSignature par "); D.Hex(fp,-8); D.Ln;
  824. END;
  825. par:=par.prevParameter;
  826. END;
  827. END;
  828. END FPSignature;
  829. (** symbols *)
  830. (*
  831. FP(TypeDeclaration) = 0 <*> fpModeType -> Name -> Visibility <*> FP(Type).
  832. *)
  833. PROCEDURE VisitTypeDeclaration(x: SyntaxTree.TypeDeclaration);
  834. VAR fp: LONGINT;
  835. fingerprint: FingerPrint; deep: BOOLEAN;
  836. BEGIN
  837. fingerprint := x.fingerprint;
  838. IF ~fingerprint.shallowAvailable THEN
  839. IF Trace THEN TraceEnter("TypeDeclaration") END;
  840. deep := SELF.deep;
  841. SELF.deep := FALSE;
  842. fp := 0;
  843. FPNumber(fp, fpModeType);
  844. FPName(fp,x.name);
  845. IF Trace THEN TraceIndent; D.String("access="); D.Set(x.access); D.Ln; END;
  846. FPVisibility(fp, x.access);
  847. x.declaredType.Accept(SELF);
  848. FPNumber(fp, SELF.fingerprint.shallow);
  849. fingerprint.shallow := fp;
  850. fingerprint.shallowAvailable := TRUE;
  851. x.SetFingerPrint(fingerprint);
  852. SELF.deep := deep;
  853. IF Trace THEN TraceExit("TypeDeclaration",fingerprint) END;
  854. END;
  855. SELF.fingerprint := fingerprint
  856. END VisitTypeDeclaration;
  857. (*
  858. FP(ConstantDeclaration) = 0 <*> fpModeConstant -> Name -> Visibility <*> FP(Type) -> Basic -> Value.
  859. *)
  860. PROCEDURE VisitConstant(x: SyntaxTree.Constant);
  861. VAR access: SET;
  862. fingerprint: FingerPrint;
  863. fp: LONGINT;
  864. deep: BOOLEAN;
  865. BEGIN
  866. fingerprint := x.fingerprint;
  867. IF ~fingerprint.shallowAvailable THEN
  868. deep := SELF.deep;
  869. SELF.deep := FALSE;
  870. fp := 0;
  871. FPNumber(fp, fpModeConst);
  872. FPName(fp,x.name);
  873. (* for compatibility with old compiler: *)
  874. access := x.access; IF SyntaxTree.PublicRead IN access THEN INCL(access,SyntaxTree.PublicWrite) END;
  875. FPVisibility(fp, access);
  876. FPType(fp, x.type);
  877. FPNumber(fp, fpTypeBasic);
  878. FPValue(fp, x.value);
  879. fingerprint.shallow := fp;
  880. fingerprint.shallowAvailable := TRUE;
  881. x.SetFingerPrint(fingerprint);
  882. SELF.deep := deep;
  883. END;
  884. SELF.fingerprint := fingerprint
  885. END VisitConstant;
  886. (*
  887. FP(VariableDeclaration) = 0 <*> fpModePar -> Name -> Visibility <*> FP(Type).
  888. *)
  889. PROCEDURE VisitVariable(x: SyntaxTree.Variable);
  890. VAR fingerprint: FingerPrint; deep: BOOLEAN; name: SyntaxTree.IdentifierString;
  891. BEGIN
  892. fingerprint := x.fingerprint;
  893. IF ~fingerprint.shallowAvailable THEN
  894. deep := SELF.deep;
  895. SELF.deep := FALSE;
  896. fp := 0;
  897. FPNumber(fp,fpModeVar);
  898. Global.GetSymbolName(x,name);
  899. FPString(fp,name);
  900. FPVisibility(fp,x.access);
  901. x.type.Accept(SELF);
  902. FPNumber(fp,SELF.fingerprint.shallow);
  903. fingerprint.shallow := fp;
  904. fingerprint.shallowAvailable := TRUE;
  905. x.SetFingerPrint(fingerprint);
  906. SELF.deep := deep;
  907. END;
  908. SELF.fingerprint := fingerprint
  909. END VisitVariable;
  910. PROCEDURE VisitProperty(x: SyntaxTree.Property);
  911. BEGIN
  912. VisitVariable(x);
  913. END VisitProperty;
  914. (*
  915. FP(ParameterDeclaration) = 0 <*> fpModePar -> Name -> Visibility <*> FP(Type).
  916. *)
  917. PROCEDURE VisitParameter(x: SyntaxTree.Parameter);
  918. VAR fingerprint: FingerPrint; deep: BOOLEAN; name: SyntaxTree.IdentifierString;
  919. BEGIN
  920. fingerprint := x.fingerprint;
  921. IF ~fingerprint.shallowAvailable THEN
  922. deep := SELF.deep;
  923. SELF.deep := FALSE;
  924. fp := 0;
  925. FPNumber(fp,fpModePar);
  926. Global.GetSymbolName(x,name);
  927. FPString(fp,name);
  928. FPVisibility(fp,x.access);
  929. x.type.Accept(SELF);
  930. FPNumber(fp,SELF.fingerprint.shallow);
  931. fingerprint.shallow := fp;
  932. fingerprint.shallowAvailable := TRUE;
  933. x.SetFingerPrint(fingerprint);
  934. SELF.deep := deep;
  935. END;
  936. SELF.fingerprint := fingerprint
  937. END VisitParameter;
  938. (*
  939. FP(ProcedureDeclaration) = 0 <*> fpModeInlineProcedure -> Name -> Visibility <*> FP(Type) -> Code.
  940. | 0 <*> fpModeExportedProcedure -> Name -> Visibility <*> FP(Type)
  941. *)
  942. PROCEDURE VisitProcedure(x: SyntaxTree.Procedure);
  943. VAR fp: LONGINT; access: SET; fingerprint: FingerPrint; deep: BOOLEAN; code: SyntaxTree.Code; i: LONGINT;
  944. size,value: LONGINT; name: ARRAY 256 OF CHAR;
  945. BEGIN
  946. IF x.scope IS SyntaxTree.RecordScope THEN (* method *)
  947. FPrintMethod(fp,fp,x,NIL);
  948. fingerprint := x.fingerprint;
  949. ELSE
  950. fingerprint := x.fingerprint;
  951. IF ~fingerprint.shallowAvailable THEN
  952. deep := SELF.deep;
  953. SELF.deep := FALSE;
  954. (* for compatibility with old compiler: *)
  955. access := x.access; IF SyntaxTree.PublicRead IN access THEN INCL(access,SyntaxTree.PublicWrite) END;
  956. fp := 0;
  957. IF x.isInline THEN
  958. FPNumber(fp, fpModeInlineProcedure);
  959. FPName(fp,x.name);
  960. FPVisibility(fp, access);
  961. FPSignature(fp,x.type(SyntaxTree.ProcedureType),x IS SyntaxTree.Operator);
  962. IF (x.procedureScope.body # NIL) & (x.procedureScope.body.code # NIL) THEN
  963. code := x.procedureScope.body.code;
  964. IF code.inlineCode = NIL THEN
  965. size := 0
  966. ELSE
  967. size := code.inlineCode.GetSize() DIV 8;
  968. END;
  969. FPNumber(fp,size);
  970. FOR i := 0 TO size-1 DO
  971. value := code.inlineCode.GetBits(i*8,8);
  972. FPNumber(fp,value);
  973. END;
  974. END;
  975. ELSE
  976. FPNumber(fp, fpModeExportedProcedure);
  977. Global.GetSymbolName(x,name);
  978. FPString(fp,name);
  979. FPVisibility(fp, access);
  980. FPSignature(fp,x.type(SyntaxTree.ProcedureType),x IS SyntaxTree.Operator);
  981. END;
  982. fingerprint.shallow := fp;
  983. fingerprint.shallowAvailable := TRUE;
  984. x.SetFingerPrint(fingerprint);
  985. SELF.deep := deep;
  986. END;
  987. END;
  988. SELF.fingerprint := fingerprint
  989. END VisitProcedure;
  990. (* cf. Procedure *)
  991. PROCEDURE VisitOperator(x: SyntaxTree.Operator);
  992. BEGIN
  993. VisitProcedure(x) (* same finger print as a procedure *)
  994. END VisitOperator;
  995. PROCEDURE VisitModule(x: SyntaxTree.Module);
  996. VAR fingerprint, symbolFingerPrint: FingerPrint; deep: BOOLEAN; fp: LONGINT; symbol: SyntaxTree.Symbol; scope: SyntaxTree.ModuleScope;
  997. BEGIN
  998. fingerprint := x.fingerprint;
  999. deep := SELF.deep;
  1000. IF Trace THEN TraceEnter("Record"); END;
  1001. IF ~fingerprint.shallowAvailable THEN
  1002. IF Trace THEN TraceIndent; D.Str("Module Enter Shallow "); D.Ln; END;
  1003. SELF.deep := FALSE;
  1004. fp := 0;
  1005. FPNumber(fp, fpTypeModule);
  1006. FPName(fp,x.name);
  1007. IF Trace THEN TraceIndent; D.Str("Module Name ");D.Hex(fp,-8); D.Ln; END;
  1008. fingerprint.shallow := fp;
  1009. fingerprint.shallowAvailable := TRUE;
  1010. x.SetFingerPrint(fingerprint);
  1011. SELF.deep := deep;
  1012. IF Trace THEN TraceIndent; D.Str("Module Shallow Done "); TraceFP(fingerprint); D.Ln; END;
  1013. END;
  1014. IF deep & ~fingerprint.deepAvailable THEN
  1015. IF Trace THEN TraceIndent; D.Str("Module Enter Deep "); D.Ln; END;
  1016. fingerprint.private := fingerprint.shallow;
  1017. fingerprint.public := fingerprint.shallow;
  1018. scope := x.moduleScope;
  1019. IF Trace THEN TraceIndent; D.Str("RecordType before methods"); TraceFP(fingerprint); D.Ln; END;
  1020. symbol := scope.firstSymbol;
  1021. WHILE symbol # NIL DO
  1022. IF symbol.access * SyntaxTree.Public # {} THEN
  1023. symbolFingerPrint := SymbolFP(symbol);
  1024. FPNumber(fingerprint.private,symbolFingerPrint.shallow);
  1025. FPNumber(fingerprint.public,symbolFingerPrint.shallow);
  1026. END;
  1027. symbol := symbol.nextSymbol;
  1028. END;
  1029. IF Trace THEN TraceIndent; D.Str("Module Exit Deep "); TraceFP(fingerprint); D.Ln; END;
  1030. (*
  1031. ASSERT(fingerprint.private # 0,100);
  1032. ASSERT(fingerprint.public # 0,101);
  1033. *)
  1034. fingerprint.deepAvailable := TRUE;
  1035. x.SetFingerPrint(fingerprint);
  1036. END;
  1037. SELF.fingerprint := fingerprint;
  1038. IF Trace THEN TraceExit("Record",fingerprint); END;
  1039. END VisitModule;
  1040. PROCEDURE VisitSymbol(x: SyntaxTree.Symbol);
  1041. BEGIN
  1042. fingerprint.shallow := 0;
  1043. fingerprint.shallowAvailable := TRUE;
  1044. x.SetFingerPrint(fingerprint);
  1045. END VisitSymbol;
  1046. PROCEDURE TraceIndent;
  1047. VAR i: LONGINT;
  1048. BEGIN
  1049. FOR i := 1 TO traceLevel DO D.Str(" "); END;
  1050. END TraceIndent;
  1051. PROCEDURE TraceEnter(CONST name: ARRAY OF CHAR);
  1052. BEGIN
  1053. INC(traceLevel); TraceIndent;
  1054. D.Str("Enter ");
  1055. D.Str(name);
  1056. D.Ln;
  1057. END TraceEnter;
  1058. PROCEDURE TraceExit(CONST name: ARRAY OF CHAR; fingerprint: FingerPrint);
  1059. BEGIN
  1060. TraceIndent; DEC(traceLevel);
  1061. D.Str("Exit "); D.Str(name); D.Str(" "); TraceFP(fingerprint); D.Ln;
  1062. END TraceExit;
  1063. PROCEDURE TraceFP(fingerprint: FingerPrint);
  1064. BEGIN
  1065. D.Hex(fingerprint.shallow,-8); D.Str(" "); D.Hex(fingerprint.private,-8);
  1066. D.Str(" "); D.Hex(fingerprint.public,-8);
  1067. END TraceFP;
  1068. (* returns the finger print (object) of a type *)
  1069. PROCEDURE TypeFP*(this: SyntaxTree.Type): FingerPrint;
  1070. VAR deep: BOOLEAN;
  1071. BEGIN
  1072. IF Trace THEN TraceEnter("TypeFP"); END;
  1073. deep := SELF.deep;
  1074. SELF.deep := TRUE;
  1075. this.Accept(SELF);
  1076. SELF.deep := deep;
  1077. ASSERT(fingerprint.deepAvailable,101);
  1078. ASSERT(fingerprint.shallow #0,102);
  1079. IF Trace THEN TraceExit("TypeFP",fingerprint); D.Ln;
  1080. D.Ln; END;
  1081. RETURN fingerprint
  1082. END TypeFP;
  1083. (* returns the finger print (object) of a symbol *)
  1084. PROCEDURE SymbolFP*(this: SyntaxTree.Symbol): FingerPrint;
  1085. VAR deep: BOOLEAN;
  1086. BEGIN
  1087. deep := SELF.deep;
  1088. SELF.deep := TRUE;
  1089. IF Trace THEN TraceEnter("SymbolFP");
  1090. TraceIndent;
  1091. D.Str("name: ");
  1092. D.Str0(this.name); D.Ln;
  1093. END;
  1094. this.Accept(SELF);
  1095. SELF.deep := deep;
  1096. IF Trace THEN TraceExit("SymbolFP",fingerprint); D.Ln; END;
  1097. RETURN fingerprint
  1098. END SymbolFP;
  1099. END FingerPrinter;
  1100. (** ---------- FingerPrinting primitives -------------- *)
  1101. PROCEDURE IsOberonProcedure(type: SyntaxTree.ProcedureType): BOOLEAN;
  1102. BEGIN
  1103. RETURN type.callingConvention = SyntaxTree.OberonCallingConvention
  1104. END IsOberonProcedure;
  1105. (* fp = fp <*> val *)
  1106. PROCEDURE FPNumber*(VAR fp: LONGINT; val: LONGINT);
  1107. BEGIN
  1108. fp:=SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, ROT(fp, 7)) / SYSTEM.VAL(SET, val))
  1109. END FPNumber;
  1110. (* fp = fp <*> set *)
  1111. PROCEDURE FPSet*(VAR fp: LONGINT; set: SET);
  1112. BEGIN FPNumber(fp, SYSTEM.VAL(LONGINT, set))
  1113. END FPSet;
  1114. (* fp = fp <*> real *)
  1115. PROCEDURE FPReal*(VAR fp: LONGINT; real: REAL);
  1116. BEGIN FPNumber(fp, SYSTEM.VAL(LONGINT, real))
  1117. END FPReal;
  1118. (* fp = fp <*> low <*> high *)
  1119. PROCEDURE FPLongReal*(VAR fp: LONGINT; lr: LONGREAL);
  1120. VAR l, h: LONGINT;
  1121. BEGIN
  1122. SYSTEM.GET(ADDRESSOF(lr)+4, l); SYSTEM.GET(ADDRESSOF(lr), h);
  1123. FPNumber(fp, l); FPNumber(fp, h);
  1124. END FPLongReal;
  1125. (* fp = fp <*> low <*> high *)
  1126. PROCEDURE FPHugeInt*(VAR fp: LONGINT; huge: HUGEINT);
  1127. VAR l, h: LONGINT;
  1128. BEGIN
  1129. SYSTEM.GET(ADDRESSOF(huge)+4, l); SYSTEM.GET(ADDRESSOF(huge), h);
  1130. FPNumber(fp, l); FPNumber(fp, h);
  1131. END FPHugeInt;
  1132. (* fp = fp -> String *)
  1133. PROCEDURE FPName*(VAR fp: LONGINT; x: SyntaxTree.Identifier);
  1134. VAR name: Scanner.IdentifierString;
  1135. BEGIN
  1136. Basic.GetString(x,name);
  1137. FPString(fp,name);
  1138. END FPName;
  1139. (* fp = fp {<*> str[i]} *)
  1140. PROCEDURE FPString*(VAR fp: LONGINT; CONST str: ARRAY OF CHAR);
  1141. VAR i: INTEGER; ch: CHAR;
  1142. BEGIN i:=0; REPEAT ch:=str[i]; FPNumber(fp, ORD(ch)); INC(i) UNTIL ch=0X
  1143. END FPString;
  1144. (* fp = fp <*> (fpExtern | fpExternR | fpIntern | fpOther + vis) *)
  1145. PROCEDURE FPVisibility*(VAR fp: LONGINT; vis: SET);
  1146. BEGIN
  1147. IF SyntaxTree.PublicWrite IN vis THEN FPNumber(fp, fpExtern)
  1148. ELSIF SyntaxTree.PublicRead IN vis THEN FPNumber(fp, fpExternR)
  1149. ELSIF SyntaxTree.Internal * vis #{} THEN FPNumber(fp, fpIntern)
  1150. ELSE
  1151. FPNumber(fp, fpOther + SYSTEM.VAL(LONGINT, vis))
  1152. END
  1153. END FPVisibility;
  1154. PROCEDURE DumpFingerPrint*(w: Streams.Writer; fp: FingerPrint);
  1155. BEGIN
  1156. w.String("fingerprint: ");
  1157. w.String("shallow = "); w.Hex(fp.shallow,8);
  1158. w.String(", private = "); w.Hex(fp.private,8);
  1159. w.String(", public = "); w.Hex(fp.public,8);
  1160. w.Ln;
  1161. END DumpFingerPrint;
  1162. END FoxFingerPrinter.