gcc/m2/gm2-compiler/M2AsmUtil.mod

   1 (* M2AsmUtil.mod provides utilities relating symbols in the SymbolTable.
   2
   3 Copyright (C) 2001-2024 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
   5
   6 This file is part of GNU Modula-2.
   7
   8 GNU Modula-2 is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 3, or (at your option)
  11 any later version.
  12
  13 GNU Modula-2 is distributed in the hope that it will be useful, but
  14 WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 General Public License for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with GNU Modula-2; see the file COPYING3.  If not see
  20 <http://www.gnu.org/licenses/>.  *)
  21
  22 IMPLEMENTATION MODULE M2AsmUtil ;
  23
  24
  25 FROM SFIO IMPORT WriteS ;
  26 FROM FIO IMPORT StdOut ;
  27 FROM DynamicStrings IMPORT String, string, ConCat, KillString, InitString, Mark, InitStringCharStar, ConCatChar, EqualArray ;
  28 FROM StdIO IMPORT Write ;
  29 FROM StrIO IMPORT WriteString ;
  30 FROM NameKey IMPORT WriteKey, GetKey, MakeKey, makekey, KeyToCharStar, NulName ;
  31 FROM M2Options IMPORT WholeProgram ;
  32 FROM M2Printf IMPORT printf1 ;
  33
  34 FROM SymbolTable IMPORT NulSym,
  35                         GetSymName, GetLibName,
  36                         GetScope,
  37                         GetBaseModule,
  38                         IsInnerModule,
  39                         IsVar,
  40                         IsProcedure,
  41                         IsModule,
  42                         IsDefImp,
  43                         IsExportQualified, IsExportUnQualified,
  44                         IsExported, IsPublic, IsExtern, IsMonoName,
  45                         IsDefinitionForC ;
  46
  47 FROM M2Error IMPORT InternalError ;
  48 FROM m2configure IMPORT UseUnderscoreForC ;
  49
  50
  51 CONST
  52    Debugging = FALSE ;
  53
  54
  55 (*
  56    StringToKey - returns a Name, from a string and destroys the string.
  57 *)
  58
  59 PROCEDURE StringToKey (s: String) : Name ;
  60 VAR
  61    k: Name ;
  62 BEGIN
  63    k := makekey (string (s)) ;
  64    s := KillString (s) ;
  65    RETURN k
  66 END StringToKey ;
  67
  68
  69 (*
  70    GetFullScopeAsmName - returns the fully qualified name for the symbol.
  71                          This will take the format
  72                          [DefImpModule|Module]_{InnerModule}_{Procedure}_SymbolName
  73 *)
  74
  75 PROCEDURE GetFullScopeAsmName (sym: CARDINAL) : Name ;
  76 VAR
  77    leader: String ;
  78    scope : CARDINAL ;
  79 BEGIN
  80    scope := GetScope (sym) ;
  81    IF UseUnderscoreForC
  82    THEN
  83       leader := InitString ('_')
  84    ELSE
  85       leader := InitString ('')
  86    END ;
  87    IF IsProcedure (sym) AND IsMonoName (sym)
  88    THEN
  89       RETURN StringToKey (ConCat (leader, InitStringCharStar (KeyToCharStar (GetSymName (sym)))))
  90
  91    ELSE
  92       RETURN StringToKey (ConCat (GetFullScopePrefix (leader, scope, sym),
  93                                   InitStringCharStar (KeyToCharStar (GetSymName (sym)))))
  94    END
  95 END GetFullScopeAsmName ;
  96
  97
  98 (*
  99    GetFullSymName - returns the NameKey for the symbol name (which also
 100                     may contain the module name).
 101 *)
 102
 103 PROCEDURE GetFullSymName (sym: CARDINAL) : Name ;
 104 VAR
 105    libname,
 106    fullsymname,
 107    module     : String ;
 108    scope      : CARDINAL ;
 109 BEGIN
 110    IF IsProcedure (sym) AND IsMonoName (sym)
 111    THEN
 112       RETURN GetSymName (sym)
 113    ELSE
 114       scope := GetScope (sym) ;
 115       module := GetModulePrefix (InitString (''), sym, scope) ;
 116       fullsymname := ConCat (module, InitStringCharStar (KeyToCharStar (GetSymName (sym)))) ;
 117       IF (IsVar (sym) OR IsProcedure (sym)) AND IsExportQualified (sym)
 118       THEN
 119          WHILE NOT IsDefImp (scope) DO
 120             scope := GetScope (scope)
 121          END ;
 122          IF GetLibName (scope) # NulName
 123          THEN
 124             IF Debugging
 125             THEN
 126                printf1 ("before sym = %s  , ", fullsymname)
 127             END ;
 128             libname := InitStringCharStar (KeyToCharStar (GetLibName (scope))) ;
 129             IF NOT EqualArray (libname, '')
 130             THEN
 131                IF Debugging
 132                THEN
 133                   printf1 ("libname = %s  , ", libname)
 134                END ;
 135                fullsymname := ConCat (ConCatChar (libname, '_'), fullsymname) ;
 136             END ;
 137             IF Debugging
 138             THEN
 139                printf1 ("after sym = %s\n", fullsymname)
 140             END
 141          END
 142       END ;
 143       RETURN StringToKey (fullsymname)
 144    END
 145 END GetFullSymName ;
 146
 147
 148 (*
 149    SymNeedsModulePrefix - return TRUE if symbol mod is required to have a prefix.
 150 *)
 151
 152 PROCEDURE SymNeedsModulePrefix (sym, mod: CARDINAL) : BOOLEAN ;
 153 BEGIN
 154    IF IsDefImp (mod)
 155    THEN
 156       IF IsExportUnQualified (sym)
 157       THEN
 158          RETURN FALSE
 159       ELSE
 160          (* We need to force the prefix if whole program is used otherwise
 161             local symbols from multipl modules might conflict.  *)
 162          RETURN WholeProgram OR IsExportQualified (sym)
 163       END
 164    ELSIF IsModule (mod)
 165    THEN
 166       RETURN WholeProgram
 167    END ;
 168    RETURN FALSE
 169 END SymNeedsModulePrefix ;
 170
 171
 172 (*
 173    GetModulePrefix - returns a String containing the module prefix
 174                      for module, ModSym, providing symbol, Sym, is exported.
 175                      Name is marked if it is appended onto the new string.
 176 *)
 177
 178 PROCEDURE GetModulePrefix (Name: String; Sym, ModSym: CARDINAL) : String ;
 179 BEGIN
 180    IF (ModSym#NulSym) AND (ModSym#GetBaseModule())
 181    THEN
 182       IF IsInnerModule(Sym) OR IsInnerModule(ModSym)
 183       THEN
 184          RETURN( ConCat(ConCatChar(InitStringCharStar(KeyToCharStar(GetSymName(ModSym))), '_'),
 185                         GetModulePrefix(Name, ModSym, GetScope(ModSym))) )
 186       ELSIF SymNeedsModulePrefix (Sym, ModSym)
 187       THEN
 188          RETURN( ConCatChar(ConCat(InitStringCharStar(KeyToCharStar(GetSymName(ModSym))), Mark(Name)), '_') )
 189       END
 190    END ;
 191    RETURN( Name )
 192 END GetModulePrefix ;
 193
 194
 195 (*
 196    GetFullScopePrefix - returns a String containing the full scope prefix
 197                         for symbol, Sym.  It honours IsExportQualified.
 198                         Name is marked if it is appended onto the new string.
 199 *)
 200
 201 PROCEDURE GetFullScopePrefix (Name: String; Scope, Sym: CARDINAL) : String ;
 202 BEGIN
 203    IF Sym#NulSym
 204    THEN
 205       IF IsInnerModule(Scope)
 206       THEN
 207          RETURN( ConCat(ConCatChar(InitStringCharStar(KeyToCharStar(GetSymName(Scope))), '_'),
 208                         GetFullScopePrefix(Name, GetScope(Scope), Sym)) )
 209       ELSIF IsDefImp(Scope) AND IsExportQualified(Sym)
 210       THEN
 211          RETURN( ConCatChar(ConCat(InitStringCharStar(KeyToCharStar(GetSymName(Scope))), Mark(Name)), '_') )
 212       ELSIF IsProcedure(Scope)
 213       THEN
 214          RETURN( ConCatChar(ConCat(InitStringCharStar(KeyToCharStar(GetSymName(Scope))), Mark(Name)), '_') )
 215       END
 216    END ;
 217    RETURN( Name )
 218 END GetFullScopePrefix ;
 219
 220
 221 END M2AsmUtil.