gpcp/ForeignName.cp

   1 (* ================================================================ *)
   2 (*                                                                  *)
   3 (*  Module of the V1.4+ gpcp tool to create symbol files from       *)
   4 (*  the metadata of .NET assemblies, using the PERWAPI interface.   *)
   5 (*  Also used in GPCP itself.                                       *)
   6 (*                                                                  *)
   7 (*  Copyright K John Gough, QUT 2004 - 2007.                        *)
   8 (*                                                                  *)
   9 (*  This code released under the terms of the GPCP licence.         *)
  10 (*                                                                  *)
  11 (* ================================================================ *)
  12
  13 MODULE ForeignName;
  14   IMPORT GPCPcopyright;
  15
  16  (* ---------------------------------------------------------- *)
  17
  18   TYPE  CharOpen* = POINTER TO ARRAY OF CHAR;
  19
  20  (* ---------------------------------------------------------- *)
  21
  22   PROCEDURE QuotedName*(asmN, nmsN : CharOpen) : CharOpen;
  23   BEGIN
  24     IF nmsN = NIL THEN RETURN BOX("[" + asmN^ + "]");
  25     ELSE RETURN BOX("[" + asmN^ + "]" + nmsN^);
  26     END;
  27   END QuotedName;
  28
  29   PROCEDURE MangledName*(asmN, nmsN : CharOpen) : CharOpen;
  30     CONST prefix = 2; equal = 1; unequal = 0;
  31     VAR   sNm, aNm : CharOpen;
  32    (* ------------------------------------------------ *)
  33     PROCEDURE canonEq(l,r : CharOpen) : INTEGER;
  34       VAR cl, cr : CHAR; ix : INTEGER;
  35     BEGIN
  36       ix := 0; cl := l[ix];
  37       WHILE cl # 0X DO
  38         cr := r[ix];
  39         IF CAP(cl) # CAP(cr) THEN RETURN unequal END;
  40         INC(ix); cl := l[ix];
  41       END;
  42       cr := r[ix];
  43       IF    cr = 0X  THEN RETURN equal;
  44       ELSIF cr = "_" THEN RETURN prefix;
  45       ELSE (* -------- *) RETURN unequal;
  46       END;
  47     END canonEq;
  48    (* ------------------------------------------------ *)
  49     PROCEDURE canonicalizeId(str : CharOpen) : CharOpen;
  50       VAR ix : INTEGER; co : CharOpen; ch : CHAR;
  51     BEGIN
  52       NEW(co, LEN(str));
  53       FOR ix := 0 TO LEN(str)-1 DO
  54         ch := str[ix];
  55         IF (ch >= 'a') & (ch <= 'z') OR
  56            (ch >= 'A') & (ch <= 'Z') OR
  57            (ch >= '0') & (ch <= '9') OR
  58            (ch >= 0C0X) & (ch <= 0D6X) OR
  59            (ch >= 0D8X) & (ch <= 0F6X) OR
  60            (ch >= 0F8X) & (ch <= 0FFX) OR
  61            (ch = 0X) THEN (* skip *) ELSE ch := '_' END;
  62         co[ix] := ch;
  63       END;
  64       RETURN co;
  65     END canonicalizeId;
  66    (* ------------------------------------------------ *)
  67     PROCEDURE merge(str : CharOpen; pos : INTEGER) : CharOpen;
  68       VAR res : CharOpen;
  69           len : INTEGER;
  70           idx : INTEGER;
  71     BEGIN
  72       len := LEN(str);
  73       NEW(res, len+1);
  74       FOR idx := 0 TO pos-1 DO res[idx] := str[idx] END;
  75       res[pos] := "_";
  76       FOR idx := pos TO len-1 DO res[idx+1] := str[idx] END;
  77       RETURN res;
  78     END merge;
  79    (* ------------------------------------------------ *)
  80   BEGIN
  81     aNm := canonicalizeId(asmN);
  82     IF (nmsN = NIL) OR (nmsN[0] = 0X) THEN
  83      (*
  84       *   There is no namespace name, so the CP
  85       *   name is "aNm" and the scopeNm is "[asmN]"
  86       *)
  87       RETURN aNm;
  88     ELSE
  89       sNm := canonicalizeId(nmsN);
  90       CASE canonEq(aNm, sNm) OF
  91       | unequal :
  92          (*
  93           *  The CP name is "aNm_sNm"
  94           *  and scopeNm is "[asmN]nmsN"
  95           *)
  96           RETURN BOX(aNm^ + "_" + sNm^);
  97       | equal   :
  98          (*
  99           *  The CP name is "sNm_"
 100           *  and scopeNm is "[asmN]nmsN"
 101           *)
 102           RETURN BOX(sNm^ + "_");
 103       | prefix  :
 104          (*
 105           *  The CP name is prefix(sNm) + "_" + suffix(sNm)
 106           *  and scopeNm is "[asmN]nmsN"
 107           *)
 108           RETURN merge(sNm, LEN(aNm$));
 109       END;
 110     END;
 111   END MangledName;
 112
 113  (* ---------------------------------------------------------- *)
 114
 115   PROCEDURE ParseModuleString*(str : CharOpen; OUT nam : CharOpen);
 116     VAR idx : INTEGER;
 117         max : INTEGER;
 118         lBr : INTEGER;
 119         rBr : INTEGER;
 120         chr : CHAR;
 121         fNm : CharOpen;
 122         cNm : CharOpen;
 123   BEGIN
 124     lBr := 0;
 125     rBr := 0;
 126     max := LEN(str^) - 1;
 127     FOR idx := 0 TO max DO
 128       chr := str[idx];
 129       IF chr = '[' THEN lBr := idx;
 130       ELSIF chr = ']' THEN rBr := idx;
 131       END;
 132     END;
 133     IF (lBr = 0) & (rBr > 1) & (rBr < max) THEN
 134       NEW(fNm, rBr - lBr);
 135       NEW(cNm, max - rBr + 1);
 136       FOR idx := 0 TO rBr - lBr - 2 DO fNm[idx] := str[idx + lBr + 1] END;
 137       FOR idx := 0 TO max - rBr - 1 DO cNm[idx] := str[idx + rBr + 1] END;
 138       nam := MangledName(fNm, cNm);
 139     ELSE
 140       nam := NIL;
 141     END;
 142   END ParseModuleString;
 143
 144  (* ---------------------------------------------------------- *)
 145
 146 END ForeignName.
 147