gpcp/SymbolFile.cp

   1 (* ==================================================================== *)
   2 (*                                                                      *)
   3 (*  SymFileRW:  Symbol-file reading and writing for GPCP.               *)
   4 (*      Copyright (c) John Gough 1999, 2000.                            *)
   5 (*                                                                      *)
   6 (* ==================================================================== *)
   7
   8 MODULE SymbolFile;
   9
  10   IMPORT
  11         GPCPcopyright,
  12         RTS,
  13         Error,
  14         GPBinFiles,
  15         FileNames,
  16         LitValue,
  17         CompState,
  18         MH := ModuleHandler;
  19
  20 (* ========================================================================= *
  21 // Collected syntax ---
  22 //
  23 // SymFile    = Header [String (falSy | truSy | <other attribute>)]
  24 //              [ VersionName ]
  25 //              {Import | Constant | Variable | Type | Procedure}
  26 //              TypeList Key.
  27 //      -- optional String is external name.
  28 //      -- falSy ==> Java class
  29 //      -- truSy ==> Java interface
  30 //      -- others ...
  31 // Header     = magic modSy Name.
  32 // VersionName= numSy longint numSy longint numSy longint.
  33 //      --            mj# mn#       bld rv#    8xbyte extract
  34 // Import     = impSy Name [String] Key.
  35 //      -- optional string is explicit external name of class
  36 // Constant   = conSy Name Literal.
  37 // Variable   = varSy Name TypeOrd.
  38 // Type       = typSy Name TypeOrd.
  39 // Procedure  = prcSy Name [String] FormalType.
  40 //      -- optional string is explicit external name of procedure
  41 // Method     = mthSy Name byte byte TypeOrd [String] FormalType.
  42 //      -- optional string is explicit external name of method
  43 // FormalType = [retSy TypeOrd] frmSy {parSy byte TypeOrd} endFm.
  44 //      -- optional phrase is return type for proper procedures
  45 // TypeOrd    = ordinal.
  46 // TypeHeader = tDefS Ord [fromS Ord Name].
  47 //      -- optional phrase occurs if:
  48 //      -- type not from this module, i.e. indirect export
  49 // TypeList   = start { Array | Record | Pointer | ProcType } close.
  50 // Array      = TypeHeader arrSy TypeOrd (Byte | Number | <empty>) endAr.
  51 //      -- nullable phrase is array length for fixed length arrays
  52 // Vector     = TypeHeader vecSy TypeOrd endAr.
  53 // Pointer    = TypeHeader ptrSy TypeOrd.
  54 // EventType  = TypeHeader evtSy FormalType.
  55 // ProcType   = TypeHeader pTpSy FormalType.
  56 // Record     = TypeHeader recSy recAtt [truSy | falSy]
  57 //              [basSy TypeOrd] [ iFcSy {basSy TypeOrd}]
  58 //              {Name TypeOrd} {OtherStuff} endRc.
  59 //      -- truSy ==> is an extension of external interface
  60 //      -- falSy ==> is an extension of external class
  61 //      -- basSy option defines base type, if not ANY / j.l.Object
  62 // OtherStuff = Method | Procedure | Variable | Constant.
  63 // Enum       = TypeHeader eTpSy { Constant } endRc.
  64 // Name       = namSy byte UTFstring.
  65 // Literal    = Number | String | Set | Char | Real | falSy | truSy.
  66 // Byte       = bytSy byte.
  67 // String     = strSy UTFstring.
  68 // Number     = numSy longint.
  69 // Real       = fltSy ieee-double.
  70 // Set        = setSy integer.
  71 // Key        = keySy integer..
  72 // Char       = chrSy unicode character.
  73 //
  74 // Notes on the syntax:
  75 // All record types must have a Name field, even though this is often
  76 // redundant.  The issue is that every record type (including those that
  77 // are anonymous in CP) corresponds to a IR class, and the definer
  78 // and the user of the class _must_ agree on the IR name of the class.
  79 // The same reasoning applies to procedure types, which must have equal
  80 // interface names in all modules.
  81 // ======================================================================== *)
  82
  83   CONST
  84         modSy = ORD('H'); namSy = ORD('$'); bytSy = ORD('\');
  85         numSy = ORD('#'); chrSy = ORD('c'); strSy = ORD('s');
  86         fltSy = ORD('r'); falSy = ORD('0'); truSy = ORD('1');
  87         impSy = ORD('I'); setSy = ORD('S'); keySy = ORD('K');
  88         conSy = ORD('C'); typSy = ORD('T'); tDefS = ORD('t');
  89         prcSy = ORD('P'); retSy = ORD('R'); mthSy = ORD('M');
  90         varSy = ORD('V'); parSy = ORD('p'); start = ORD('&');
  91         close = ORD('!'); recSy = ORD('{'); endRc = ORD('}');
  92         frmSy = ORD('('); fromS = ORD('@'); endFm = ORD(')');
  93         arrSy = ORD('['); endAr = ORD(']'); pTpSy = ORD('%');
  94         ptrSy = ORD('^'); basSy = ORD('+'); eTpSy = ORD('e');
  95         iFcSy = ORD('~'); evtSy = ORD('v'); vecSy = ORD('*');
  96
  97   CONST
  98         magic   = 0DEADD0D0H;
  99         syMag   = 0D0D0DEADH;
 100
 101   VAR
 102     file* : GPBinFiles.FILE;
 103     fileName* : FileNames.NameString;
 104     sSym : INTEGER;
 105     cAtt : CHAR;
 106     iAtt : INTEGER;
 107     lAtt : LONGINT;
 108     rAtt : REAL;
 109     sAtt : LitValue.CharOpen;
 110
 111 (* ============================================================ *)
 112 (* ========     Various reading utility procedures      ======= *)
 113 (* ============================================================ *)
 114
 115   PROCEDURE read() : INTEGER;
 116   BEGIN
 117     RETURN GPBinFiles.readByte(file);
 118   END read;
 119
 120 (* ======================================= *)
 121
 122   PROCEDURE readUTF() : LitValue.CharOpen;
 123     CONST
 124       bad = "Bad UTF-8 string";
 125     VAR num : INTEGER;
 126       bNm : INTEGER;
 127       len : INTEGER;
 128       idx : INTEGER;
 129       chr : INTEGER;
 130       buff : LitValue.CharOpen;
 131   BEGIN
 132     num := 0;
 133    (*
 134     *  bNm is the length in bytes of the UTF8 representation
 135     *)
 136     len := read() * 256 + read();  (* max length 65k *)
 137    (*
 138     *  Worst case the number of chars will equal byte-number.
 139     *)
 140     NEW(buff, len + 1);
 141     idx := 0;
 142     WHILE idx < len DO
 143       chr := read(); INC(idx);
 144       IF chr <= 07FH THEN               (* [0xxxxxxx] *)
 145         buff[num] := CHR(chr); INC(num);
 146       ELSIF chr DIV 32 = 06H THEN       (* [110xxxxx,10xxxxxx] *)
 147         bNm := chr MOD 32 * 64;
 148         chr := read(); INC(idx);
 149         IF chr DIV 64 = 02H THEN
 150           buff[num] := CHR(bNm + chr MOD 64); INC(num);
 151         ELSE
 152           RTS.Throw(bad);
 153         END;
 154       ELSIF chr DIV 16 = 0EH THEN       (* [1110xxxx,10xxxxxx,10xxxxxxx] *)
 155         bNm := chr MOD 16 * 64;
 156         chr := read(); INC(idx);
 157         IF chr DIV 64 = 02H THEN
 158           bNm := (bNm + chr MOD 64) * 64;
 159           chr := read(); INC(idx);
 160           IF chr DIV 64 = 02H THEN
 161             buff[num] := CHR(bNm + chr MOD 64); INC(num);
 162           ELSE
 163             RTS.Throw(bad);
 164           END;
 165         ELSE
 166           RTS.Throw(bad);
 167         END;
 168       ELSE
 169         RTS.Throw(bad);
 170       END;
 171     END;
 172     buff[num] := 0X;
 173     RETURN LitValue.arrToCharOpen(buff, num);
 174   END readUTF;
 175
 176 (* ======================================= *)
 177
 178   PROCEDURE readChar() : CHAR;
 179   BEGIN
 180     RETURN CHR(read() * 256 + read());
 181   END readChar;
 182
 183 (* ======================================= *)
 184
 185   PROCEDURE readInt() : INTEGER;
 186   BEGIN [UNCHECKED_ARITHMETIC]
 187     (* overflow checking off here *)
 188     RETURN ((read() * 256 + read()) * 256 + read()) * 256 + read();
 189   END readInt;
 190
 191 (* ======================================= *)
 192
 193   PROCEDURE readLong() : LONGINT;
 194     VAR result : LONGINT;
 195         index  : INTEGER;
 196   BEGIN [UNCHECKED_ARITHMETIC]
 197     (* overflow checking off here *)
 198     result := read();
 199     FOR index := 1 TO 7 DO
 200       result := result * 256 + read();
 201     END;
 202     RETURN result;
 203   END readLong;
 204
 205 (* ======================================= *)
 206
 207   PROCEDURE readReal() : REAL;
 208     VAR result : LONGINT;
 209   BEGIN
 210     result := readLong();
 211     RETURN RTS.longBitsToReal(result);
 212   END readReal;
 213
 214 (* ======================================= *)
 215
 216   PROCEDURE readOrd() : INTEGER;
 217     VAR chr : INTEGER;
 218   BEGIN
 219     chr := read();
 220     IF chr <= 07FH THEN RETURN chr;
 221     ELSE
 222       DEC(chr, 128);
 223       RETURN chr + read() * 128;
 224     END;
 225   END readOrd;
 226
 227 (* ============================================================ *)
 228 (* ========             Symbol File Reader              ======= *)
 229 (* ============================================================ *)
 230
 231   PROCEDURE SymError(IN msg : ARRAY OF CHAR);
 232   BEGIN
 233     Error.WriteString("Error in <" + fileName + "> : ");
 234     Error.WriteString(msg); Error.WriteLn;
 235   END SymError;
 236
 237 (* ======================================= *)
 238
 239   PROCEDURE GetSym();
 240   BEGIN
 241     sSym := read();
 242     CASE sSym OF
 243     | namSy :
 244         iAtt := read();
 245         sAtt := readUTF();
 246     | strSy :
 247         sAtt := readUTF();
 248     | retSy, fromS, tDefS, basSy :
 249         iAtt := readOrd();
 250     | bytSy :
 251         iAtt := read();
 252     | keySy, setSy :
 253         iAtt := readInt();
 254     | numSy :
 255         lAtt := readLong();
 256     | fltSy :
 257         rAtt := readReal();
 258     | chrSy :
 259         cAtt := readChar();
 260     ELSE (* nothing to do *)
 261     END;
 262   END GetSym;
 263
 264 (* ======================================= *)
 265
 266   PROCEDURE Check(sym : INTEGER);
 267   BEGIN
 268     IF sSym # sym THEN
 269       Error.WriteString("Expected " );
 270       Error.WriteInt(sym,0);
 271       Error.WriteString(" but got " );
 272       Error.WriteInt(sSym,0);
 273       Error.WriteLn;
 274       THROW("Bad symbol file format");
 275     END;
 276   END Check;
 277
 278   PROCEDURE CheckAndGet(sym : INTEGER);
 279   VAR
 280     ok : BOOLEAN;
 281   BEGIN
 282     IF sSym # sym THEN
 283       Error.WriteString("Expected " );
 284       Error.WriteInt(sym,0);
 285       Error.WriteString(" but got " );
 286       Error.WriteInt(sSym,0);
 287       Error.WriteLn;
 288       THROW("Bad symbol file format");
 289     END;
 290     GetSym();
 291   END CheckAndGet;
 292
 293 (* ======================================= *)
 294
 295   PROCEDURE OpenSymbolFile*(IN name : ARRAY OF CHAR; onPath : BOOLEAN);
 296   BEGIN
 297     fileName := name + ".cps";
 298     IF onPath THEN
 299       file := GPBinFiles.findOnPath(CompState.cpSymX, fileName);
 300     ELSE
 301       file := GPBinFiles.findLocal(fileName);
 302     END;
 303   END OpenSymbolFile;
 304
 305 (* ======================================= *)
 306
 307
 308   PROCEDURE SkipFormalType();
 309   (*
 310   // FormalType = [retSy TypeOrd] frmSy {parSy byte TypeOrd} endFm.
 311   //    -- optional phrase is return type for proper procedures
 312   *)
 313     VAR
 314         byte : INTEGER;
 315   BEGIN
 316     IF sSym = retSy THEN GetSym(); END;
 317     CheckAndGet(frmSy);
 318     WHILE sSym = parSy DO
 319       byte := read();
 320       byte := readOrd();
 321       GetSym();
 322       IF sSym = strSy THEN GetSym() END;
 323     END;
 324     CheckAndGet(endFm);
 325   END SkipFormalType;
 326
 327 (* ============================================ *)
 328
 329   PROCEDURE TypeList();
 330   (* TypeList   = start { Array | Record | Pointer | ProcType } close. *)
 331   (* TypeHeader = tDefS Ord [fromS Ord Name].                          *)
 332     VAR
 333       num, oldS : INTEGER;
 334       tmp : INTEGER;
 335   BEGIN
 336     WHILE sSym = tDefS DO
 337       GetSym();
 338       IF sSym = fromS THEN
 339         GetSym();  (* fromS *)
 340         GetSym();  (* Name *)
 341       END;
 342      (* Get type info. *)
 343       CASE sSym OF
 344       | arrSy : num := readOrd();
 345                 GetSym();
 346                 IF (sSym = bytSy) OR (sSym = numSy) THEN GetSym(); END;
 347                 CheckAndGet(endAr);
 348       | vecSy : num := readOrd();
 349                 GetSym();
 350                 CheckAndGet(endAr);
 351       | eTpSy : GetSym();
 352                 WHILE sSym = conSy DO
 353                   GetSym();  (* read past conSy *)
 354                   CheckAndGet(namSy);
 355                   GetSym();  (* read past literal *)
 356                 END;
 357                 CheckAndGet(endRc);
 358       | recSy : num := read();
 359                 GetSym();
 360                 IF (sSym = falSy) OR (sSym = truSy) THEN GetSym(); END;
 361                 IF (sSym = basSy) THEN GetSym(); END;
 362                 IF sSym = iFcSy THEN
 363                   GetSym();
 364                   WHILE sSym = basSy DO GetSym() END;
 365                 END;
 366                 WHILE sSym = namSy DO num := readOrd(); GetSym(); END;
 367                 WHILE (sSym = mthSy) OR (sSym = conSy) OR
 368                       (sSym = prcSy) OR (sSym = varSy) DO
 369                   oldS := sSym; GetSym();
 370                   IF oldS = mthSy THEN
 371                     (* mthSy Name byte byte TypeOrd [String] FormalType. *)
 372                      Check(namSy);
 373                      num := read();
 374                      num := read();
 375                      num := readOrd();
 376                      GetSym();
 377                      IF sSym = strSy THEN GetSym(); END;
 378                      IF sSym = namSy THEN GetSym(); END;
 379                      SkipFormalType();
 380                   ELSIF oldS = conSy THEN (* Name Literal *)
 381                      CheckAndGet(namSy);
 382                      GetSym();
 383                   ELSIF oldS = prcSy THEN (* Name [String] FormalType. *)
 384                      CheckAndGet(namSy);
 385                      IF sSym = strSy THEN GetSym(); END;
 386                      IF sSym = truSy THEN GetSym(); END;
 387                      SkipFormalType();
 388                   ELSE (* Name TypeOrd. *)
 389                     Check(namSy);
 390                     tmp := readOrd();
 391                     GetSym();
 392                   END;
 393                 END;
 394                 CheckAndGet(endRc);
 395       | ptrSy : num := readOrd(); GetSym();
 396       | pTpSy, evtSy : GetSym(); SkipFormalType();
 397       ELSE (* skip *)
 398       END;
 399     END;
 400     GetSym();
 401   END TypeList;
 402
 403 (* ============================================ *)
 404
 405   PROCEDURE ReadSymbolFile*(mod : MH.ModInfo; addKeys : BOOLEAN);
 406   (*
 407   // SymFile    = Header [String (falSy | truSy | <others>)]
 408   //            {Import | Constant | Variable | Type | Procedure}
 409   //            TypeList Key.
 410   // Header     = magic modSy Name.
 411   //
 412   *)
 413   VAR
 414     marker   : INTEGER;
 415     oldS,tmp : INTEGER;
 416     impMod   : MH.ModInfo;
 417   BEGIN
 418     impMod := NIL;
 419     marker := readInt();
 420     IF (marker = RTS.loInt(magic)) OR (marker = RTS.loInt(syMag)) THEN
 421       (* normal case, nothing to do *)
 422     ELSE
 423       SymError("Bad symbol file format.");
 424       RETURN;
 425     END;
 426     GetSym();
 427     CheckAndGet(modSy);
 428     Check(namSy);
 429     IF mod.name^ # sAtt^ THEN
 430       SymError("Wrong name in symbol file. Expected <" + mod.name^ +
 431                 ">, found <" + sAtt^ + ">");
 432       RETURN;
 433     END;
 434     GetSym();
 435     IF sSym = strSy THEN (* optional name *)
 436       GetSym();
 437       IF (sSym = falSy) OR (sSym = truSy) THEN
 438         GetSym();
 439       ELSE
 440         SymError("Bad explicit name in symbol file.");
 441         RETURN;
 442       END;
 443     END;
 444
 445     IF sSym = numSy THEN   (* optional strong name info.    *)
 446       (* ignore major, minor and get next symbol *)
 447       GetSym();
 448       (* ignore build, revision and get next symbol *)
 449       GetSym();
 450       (* ignore assembly publickeytoken and get next symbol *)
 451       GetSym();
 452     END;
 453
 454     LOOP
 455       oldS := sSym;
 456       GetSym();
 457       CASE oldS OF
 458       | start : EXIT;
 459       | typSy, varSy : tmp := readOrd(); GetSym(); (* Name typeOrd *)
 460       | impSy : IF addKeys THEN impMod := MH.GetModule(sAtt); END;
 461                 GetSym();
 462                 IF sSym = strSy THEN GetSym(); END;
 463                 Check(keySy);
 464                 IF addKeys THEN MH.AddKey(mod,impMod,iAtt); END;
 465                 GetSym();
 466       | conSy : GetSym(); GetSym();  (* Name Literal *)
 467       | prcSy : (* Name [String] FormalType *);
 468                 GetSym();
 469                 IF sSym = strSy THEN GetSym(); END;
 470                 SkipFormalType();
 471       ELSE SymError("Bad symbol file format."); EXIT;
 472       END;
 473     END;
 474     TypeList();
 475     IF sSym = keySy THEN
 476       mod.key := iAtt;
 477     ELSE
 478       SymError("Missing keySy");
 479     END;
 480     GPBinFiles.CloseFile(file);
 481   END ReadSymbolFile;
 482
 483   PROCEDURE CloseSymFile*();
 484   BEGIN
 485     IF file # NIL THEN GPBinFiles.CloseFile(file) END;
 486   END CloseSymFile;
 487
 488 (* ============================================================ *)
 489 BEGIN
 490 END SymbolFile.
 491 (* ============================================================ *)