Browse Source

+ support for dll variables

peter 27 years ago
parent
commit
b4045fe57e
8 changed files with 274 additions and 136 deletions
  1. 17 1
      compiler/cg386ld.pas
  2. 37 12
      compiler/import.pas
  3. 15 1
      compiler/lin_targ.pas
  4. 57 28
      compiler/pdecl.pas
  5. 6 3
      compiler/pmodules.pas
  6. 42 40
      compiler/symsym.inc
  7. 12 8
      compiler/symsymh.inc
  8. 88 43
      compiler/win_targ.pas

+ 17 - 1
compiler/cg386ld.pas

@@ -71,6 +71,7 @@ implementation
               varsym :
               varsym :
                  begin
                  begin
                     hregister:=R_NO;
                     hregister:=R_NO;
+                    { C variable }
                     if (pvarsym(p^.symtableentry)^.var_options and vo_is_C_var)<>0 then
                     if (pvarsym(p^.symtableentry)^.var_options and vo_is_C_var)<>0 then
                       begin
                       begin
                          stringdispose(p^.location.reference.symbol);
                          stringdispose(p^.location.reference.symbol);
@@ -78,6 +79,18 @@ implementation
                          if (pvarsym(p^.symtableentry)^.var_options and vo_is_external)<>0 then
                          if (pvarsym(p^.symtableentry)^.var_options and vo_is_external)<>0 then
                            maybe_concat_external(p^.symtableentry^.owner,p^.symtableentry^.mangledname);
                            maybe_concat_external(p^.symtableentry^.owner,p^.symtableentry^.mangledname);
                       end
                       end
+                    { DLL variable }
+                    else if (pvarsym(p^.symtableentry)^.var_options and vo_is_dll_var)<>0 then
+                      begin
+                         hregister:=getregister32;
+                         stringdispose(p^.location.reference.symbol);
+                         p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
+                         exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.location.reference),hregister)));
+                         stringdispose(p^.location.reference.symbol);
+                         p^.location.reference.base:=hregister;
+                         if (pvarsym(p^.symtableentry)^.var_options and vo_is_external)<>0 then
+                           maybe_concat_external(p^.symtableentry^.owner,p^.symtableentry^.mangledname);
+                      end
                     else
                     else
                       begin
                       begin
                          symtabletype:=p^.symtable^.symtabletype;
                          symtabletype:=p^.symtable^.symtabletype;
@@ -679,7 +692,10 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.33  1998-11-27 14:50:33  peter
+  Revision 1.34  1998-11-28 16:20:48  peter
+    + support for dll variables
+
+  Revision 1.33  1998/11/27 14:50:33  peter
     + open strings, $P switch support
     + open strings, $P switch support
 
 
   Revision 1.32  1998/11/26 09:53:36  florian
   Revision 1.32  1998/11/26 09:53:36  florian

+ 37 - 12
compiler/import.pas

@@ -26,19 +26,22 @@ uses
   cobjects;
   cobjects;
 
 
 type
 type
-   pimported_procedure = ^timported_procedure;
-   timported_procedure = object(tlinkedlist_item)
-      ordnr : word;
-      name,func : pstring;
-      lab : pointer; { should be plabel, but this gaves problems with circular units }
+   pimported_item = ^timported_item;
+   timported_item = object(tlinkedlist_item)
+      ordnr  : word;
+      name,
+      func   : pstring;
+      lab    : pointer; { should be plabel, but this gaves problems with circular units }
+      is_var : boolean;
       constructor init(const n,s : string;o : word);
       constructor init(const n,s : string;o : word);
+      constructor init_var(const n,s : string);
       destructor done;virtual;
       destructor done;virtual;
    end;
    end;
 
 
    pimportlist = ^timportlist;
    pimportlist = ^timportlist;
    timportlist = object(tlinkedlist_item)
    timportlist = object(tlinkedlist_item)
       dllname : pstring;
       dllname : pstring;
-      imported_procedures : plinkedlist;
+      imported_items : plinkedlist;
       constructor init(const n : string);
       constructor init(const n : string);
       destructor done;virtual;
       destructor done;virtual;
    end;
    end;
@@ -49,6 +52,7 @@ type
       destructor Done;
       destructor Done;
       procedure preparelib(const s:string);virtual;
       procedure preparelib(const s:string);virtual;
       procedure importprocedure(const func,module:string;index:longint;const name:string);virtual;
       procedure importprocedure(const func,module:string;index:longint;const name:string);virtual;
+      procedure importvariable(const varname,module:string;const name:string);virtual;
       procedure generatelib;virtual;
       procedure generatelib;virtual;
    end;
    end;
 
 
@@ -70,20 +74,32 @@ uses
   ;
   ;
 
 
 {****************************************************************************
 {****************************************************************************
-                           TImported_procedure
+                           Timported_item
 ****************************************************************************}
 ****************************************************************************}
 
 
-constructor timported_procedure.init(const n,s : string;o : word);
+constructor timported_item.init(const n,s : string;o : word);
 begin
 begin
   inherited init;
   inherited init;
   func:=stringdup(n);
   func:=stringdup(n);
   name:=stringdup(s);
   name:=stringdup(s);
   ordnr:=o;
   ordnr:=o;
   lab:=nil;
   lab:=nil;
+  is_var:=false;
 end;
 end;
 
 
 
 
-destructor timported_procedure.done;
+constructor timported_item.init_var(const n,s : string);
+begin
+  inherited init;
+  func:=stringdup(n);
+  name:=stringdup(s);
+  ordnr:=0;
+  lab:=nil;
+  is_var:=true;
+end;
+
+
+destructor timported_item.done;
 begin
 begin
   stringdispose(name);
   stringdispose(name);
   inherited done;
   inherited done;
@@ -98,13 +114,13 @@ constructor timportlist.init(const n : string);
 begin
 begin
   inherited init;
   inherited init;
   dllname:=stringdup(n);
   dllname:=stringdup(n);
-  imported_procedures:=new(plinkedlist,init);
+  imported_items:=new(plinkedlist,init);
 end;
 end;
 
 
 
 
 destructor timportlist.done;
 destructor timportlist.done;
 begin
 begin
-  dispose(imported_procedures,done);
+  dispose(imported_items,done);
   stringdispose(dllname);
   stringdispose(dllname);
 end;
 end;
 
 
@@ -135,6 +151,12 @@ begin
 end;
 end;
 
 
 
 
+procedure timportlib.importvariable(const varname,module:string;const name:string);
+begin
+  Message(exec_e_dll_not_supported);
+end;
+
+
 procedure timportlib.generatelib;
 procedure timportlib.generatelib;
 begin
 begin
   Message(exec_e_dll_not_supported);
   Message(exec_e_dll_not_supported);
@@ -172,7 +194,10 @@ end;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.8  1998-10-19 18:07:12  peter
+  Revision 1.9  1998-11-28 16:20:50  peter
+    + support for dll variables
+
+  Revision 1.8  1998/10/19 18:07:12  peter
     + external dll_name name func support for linux
     + external dll_name name func support for linux
 
 
   Revision 1.7  1998/10/19 15:41:02  peter
   Revision 1.7  1998/10/19 15:41:02  peter

+ 15 - 1
compiler/lin_targ.pas

@@ -31,6 +31,7 @@ interface
     timportliblinux=object(timportlib)
     timportliblinux=object(timportlib)
       procedure preparelib(const s:string);virtual;
       procedure preparelib(const s:string);virtual;
       procedure importprocedure(const func,module:string;index:longint;const name:string);virtual;
       procedure importprocedure(const func,module:string;index:longint;const name:string);virtual;
+      procedure importvariable(const varname,module:string;const name:string);virtual;
       procedure generatelib;virtual;
       procedure generatelib;virtual;
     end;
     end;
 
 
@@ -56,6 +57,16 @@ implementation
       end;
       end;
 
 
 
 
+    procedure timportliblinux.importvariable(const varname,module:string;const name:string);
+      begin
+        { insert sharedlibrary }
+        current_module^.linksharedlibs.insert(SplitName(module));
+        { reset the mangledname and turn off the dll_var option }
+        aktvarsym^.setmangledname(name);
+        aktvarsym^.var_options:=aktvarsym^.var_options and (not vo_is_dll_var);
+      end;
+
+
     procedure timportliblinux.generatelib;
     procedure timportliblinux.generatelib;
       begin
       begin
       end;
       end;
@@ -64,7 +75,10 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.1  1998-10-19 18:07:13  peter
+  Revision 1.2  1998-11-28 16:20:51  peter
+    + support for dll variables
+
+  Revision 1.1  1998/10/19 18:07:13  peter
     + external dll_name name func support for linux
     + external dll_name name func support for linux
 
 
 }
 }

+ 57 - 28
compiler/pdecl.pas

@@ -56,7 +56,7 @@ unit pdecl;
 
 
     uses
     uses
        cobjects,scanner,aasm,tree,pass_1,
        cobjects,scanner,aasm,tree,pass_1,
-       files,types,hcodegen,verbose,systems
+       files,types,hcodegen,verbose,systems,import
 {$ifdef GDB}
 {$ifdef GDB}
        ,gdb
        ,gdb
 {$endif GDB}
 {$endif GDB}
@@ -76,7 +76,7 @@ unit pdecl;
     { search in symtablestack used, but not defined type }
     { search in symtablestack used, but not defined type }
     procedure testforward_type(p : psym);{$ifndef FPC}far;{$endif}
     procedure testforward_type(p : psym);{$ifndef FPC}far;{$endif}
       var
       var
-        recsymtable : psymtable;
+        reaktvarsymtable : psymtable;
         oldaktfilepos : tfileposinfo;
         oldaktfilepos : tfileposinfo;
       begin
       begin
          if not(p^.typ=typesym) then
          if not(p^.typ=typesym) then
@@ -95,13 +95,13 @@ unit pdecl;
           if (ptypesym(p)^.definition^.deftype in [recorddef,objectdef]) then
           if (ptypesym(p)^.definition^.deftype in [recorddef,objectdef]) then
            begin
            begin
              if (ptypesym(p)^.definition^.deftype=recorddef) then
              if (ptypesym(p)^.definition^.deftype=recorddef) then
-               recsymtable:=precdef(ptypesym(p)^.definition)^.symtable
+               reaktvarsymtable:=precdef(ptypesym(p)^.definition)^.symtable
              else
              else
-               recsymtable:=pobjectdef(ptypesym(p)^.definition)^.publicsyms;
+               reaktvarsymtable:=pobjectdef(ptypesym(p)^.definition)^.publicsyms;
            {$ifdef tp}
            {$ifdef tp}
-             recsymtable^.foreach(testforward_type);
+             reaktvarsymtable^.foreach(testforward_type);
            {$else}
            {$else}
-             recsymtable^.foreach(@testforward_type);
+             reaktvarsymtable^.foreach(@testforward_type);
            {$endif}
            {$endif}
            end;
            end;
       end;
       end;
@@ -258,9 +258,10 @@ unit pdecl;
          l    : longint;
          l    : longint;
          code : word;
          code : word;
          { c var }
          { c var }
-         Csym : pvarsym;
          newtype : ptypesym;
          newtype : ptypesym;
-         is_gpc_name,is_cdecl,extern_Csym,export_Csym : boolean;
+         is_dll,
+         is_gpc_name,is_cdecl,extern_aktvarsym,export_aktvarsym : boolean;
+         dll_name,
          C_name : string;
          C_name : string;
          { case }
          { case }
          p,casedef : pdef;
          p,casedef : pdef;
@@ -303,11 +304,11 @@ unit pdecl;
                   if not sc^.empty then
                   if not sc^.empty then
                    Message(parser_e_absolute_only_one_var);
                    Message(parser_e_absolute_only_one_var);
                   dispose(sc,done);
                   dispose(sc,done);
-                  Csym:=new(pvarsym,init_C(s,target_os.Cprefix+C_name,p));
+                  aktvarsym:=new(pvarsym,init_C(s,target_os.Cprefix+C_name,p));
                   tokenpos:=storetokenpos;
                   tokenpos:=storetokenpos;
-                  Csym^.var_options:=Csym^.var_options or vo_is_external;
-                  externals^.concat(new(pai_external,init(Csym^.mangledname,EXT_NEAR)));
-                  symtablestack^.insert(Csym);
+                  aktvarsym^.var_options:=aktvarsym^.var_options or vo_is_external;
+                  externals^.concat(new(pai_external,init(aktvarsym^.mangledname,EXT_NEAR)));
+                  symtablestack^.insert(aktvarsym);
                   symdone:=true;
                   symdone:=true;
                end;
                end;
            { check for absolute }
            { check for absolute }
@@ -412,9 +413,10 @@ unit pdecl;
                     Message(parser_e_absolute_only_one_var);
                     Message(parser_e_absolute_only_one_var);
                    dispose(sc,done);
                    dispose(sc,done);
                    { defaults }
                    { defaults }
+                   is_dll:=false;
                    is_cdecl:=false;
                    is_cdecl:=false;
-                   extern_csym:=false;
-                   export_Csym:=false;
+                   extern_aktvarsym:=false;
+                   export_aktvarsym:=false;
                    { cdecl }
                    { cdecl }
                    if idtoken=_CVAR then
                    if idtoken=_CVAR then
                     begin
                     begin
@@ -427,20 +429,27 @@ unit pdecl;
                    if idtoken=_EXTERNAL then
                    if idtoken=_EXTERNAL then
                     begin
                     begin
                       consume(_EXTERNAL);
                       consume(_EXTERNAL);
-                      extern_csym:=true;
+                      extern_aktvarsym:=true;
                     end;
                     end;
                    { export }
                    { export }
                    if idtoken in [_EXPORT,_PUBLIC] then
                    if idtoken in [_EXPORT,_PUBLIC] then
                     begin
                     begin
                       consume(ID);
                       consume(ID);
-                      if extern_csym then
+                      if extern_aktvarsym then
                        Message(parser_e_not_external_and_export)
                        Message(parser_e_not_external_and_export)
                       else
                       else
-                       export_Csym:=true;
+                       export_aktvarsym:=true;
                     end;
                     end;
                  { external and export need a name after when no cdecl is used }
                  { external and export need a name after when no cdecl is used }
                    if not is_cdecl then
                    if not is_cdecl then
                     begin
                     begin
+                      { dll name ? }
+                      if (extern_aktvarsym) and (token=CSTRING) then
+                       begin
+                         is_dll:=true;
+                         dll_name:=pattern;
+                         consume(CSTRING);
+                       end;
                       consume(_NAME);
                       consume(_NAME);
                       C_name:=pattern;
                       C_name:=pattern;
                     { allow also char }
                     { allow also char }
@@ -450,22 +459,39 @@ unit pdecl;
                        consume(CSTRING);
                        consume(CSTRING);
                     end;
                     end;
                  { consume the ; when export or external is used }
                  { consume the ; when export or external is used }
-                   if extern_csym or export_csym then
+                   if extern_aktvarsym or export_aktvarsym then
                     consume(SEMICOLON);
                     consume(SEMICOLON);
                    { insert in the symtable }
                    { insert in the symtable }
                    storetokenpos:=tokenpos;
                    storetokenpos:=tokenpos;
                    tokenpos:=declarepos;
                    tokenpos:=declarepos;
-                   Csym:=new(pvarsym,init_C(s,C_name,p));
+                   if is_dll then
+                    aktvarsym:=new(pvarsym,init_dll(s,p))
+                   else
+                    aktvarsym:=new(pvarsym,init_C(s,C_name,p));
                    tokenpos:=storetokenpos;
                    tokenpos:=storetokenpos;
-                   if export_Csym then
-                    inc(Csym^.refs);
-                   if extern_Csym then
+                   { set some vars options }
+                   if export_aktvarsym then
+                    inc(aktvarsym^.refs);
+                   if extern_aktvarsym then
+                      aktvarsym^.var_options:=aktvarsym^.var_options or vo_is_external;
+                   { insert in the stack/datasegment }
+                   symtablestack^.insert(aktvarsym);
+                   { now we can insert it in the import lib if its a dll, or
+                     add it to the externals }
+                   if extern_aktvarsym then
                     begin
                     begin
-                      Csym^.var_options:=Csym^.var_options or vo_is_external;
-                      { correct type ?? }
-                      externals^.concat(new(pai_external,init(Csym^.mangledname,EXT_NEAR)));
+                      if is_dll then
+                       begin
+                         if not(current_module^.uses_imports) then
+                          begin
+                            current_module^.uses_imports:=true;
+                            importlib^.preparelib(current_module^.modulename^);
+                          end;
+                         importlib^.importvariable(aktvarsym^.mangledname,dll_name,C_name)
+                       end
+                      else
+                      externals^.concat(new(pai_external,init(aktvarsym^.mangledname,EXT_NEAR)));
                     end;
                     end;
-                   symtablestack^.insert(Csym);
                    symdone:=true;
                    symdone:=true;
                  end
                  end
                 else
                 else
@@ -1037,7 +1063,7 @@ unit pdecl;
          hs         : string;
          hs         : string;
          pcrd       : pclassrefdef;
          pcrd       : pclassrefdef;
          hp1        : pdef;
          hp1        : pdef;
-         oldprocsym : Pprocsym;
+         oldprocsym : pprocsym;
          oldparse_only : boolean;
          oldparse_only : boolean;
          classnamelabel : plabel;
          classnamelabel : plabel;
          storetypeforwardsallowed : boolean;
          storetypeforwardsallowed : boolean;
@@ -2097,7 +2123,10 @@ unit pdecl;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.85  1998-11-27 14:34:43  peter
+  Revision 1.86  1998-11-28 16:20:52  peter
+    + support for dll variables
+
+  Revision 1.85  1998/11/27 14:34:43  peter
     * give error when string[0] decl is found
     * give error when string[0] decl is found
 
 
   Revision 1.84  1998/11/17 10:40:15  peter
   Revision 1.84  1998/11/17 10:40:15  peter

+ 6 - 3
compiler/pmodules.pas

@@ -163,7 +163,7 @@ unit pmodules;
               { Generate an external entry to be sure that _mainCRTStarup will be
               { Generate an external entry to be sure that _mainCRTStarup will be
                 linked, can't use concat_external because those aren't written for
                 linked, can't use concat_external because those aren't written for
                 asw (PFV) }
                 asw (PFV) }
-              datasegment^.concat(new(pai_const,init_symbol('_mainCRTStartup')));
+              datasegment^.concat(new(pai_const,init_symbol(strpnew('_mainCRTStartup'))));
             end;
             end;
 {$endif i386}
 {$endif i386}
 {$ifdef m68k}
 {$ifdef m68k}
@@ -1099,7 +1099,7 @@ unit pmodules;
 
 
          if islibrary then
          if islibrary then
            exportlib^.generatelib;
            exportlib^.generatelib;
-           
+
          { insert heap }
          { insert heap }
          insertheap;
          insertheap;
 
 
@@ -1132,7 +1132,10 @@ unit pmodules;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.84  1998-11-18 09:18:03  pierre
+  Revision 1.85  1998-11-28 16:20:54  peter
+    + support for dll variables
+
+  Revision 1.84  1998/11/18 09:18:03  pierre
     + automatic loading of profile unit with -pg option
     + automatic loading of profile unit with -pg option
       in go32v2 mode (also defines FPC_PROFILE)
       in go32v2 mode (also defines FPC_PROFILE)
     * some memory leaks removed
     * some memory leaks removed

+ 42 - 40
compiler/symsym.inc

@@ -770,6 +770,7 @@
          if read_member then
          if read_member then
            writelong(address);
            writelong(address);
          writedefref(definition);
          writedefref(definition);
+         writebyte(var_options and (not vo_regable));
          writebyte(byte(abstyp));
          writebyte(byte(abstyp));
          case abstyp of
          case abstyp of
            tovar : writestring(ref^.name);
            tovar : writestring(ref^.name);
@@ -857,12 +858,32 @@
          reg:=R_NO;
          reg:=R_NO;
       end;
       end;
 
 
-    constructor tvarsym.load;
 
 
+    constructor tvarsym.init_dll(const n : string;p : pdef);
+      begin
+      { The tvarsym is necessary for 0.99.5 (PFV) }
+         tvarsym.init(n,p);
+         var_options:=var_options or vo_is_dll_var;
+      end;
+
+
+    constructor tvarsym.init_C(const n,mangled : string;p : pdef);
+      begin
+      { The tvarsym is necessary for 0.99.5 (PFV) }
+         tvarsym.init(n,p);
+         var_options:=var_options or vo_is_C_var;
+         setmangledname(mangled);
+      end;
+
+
+    constructor tvarsym.load;
       begin
       begin
          tsym.load;
          tsym.load;
          typ:=varsym;
          typ:=varsym;
          _mangledname:=nil;
          _mangledname:=nil;
+         reg:=R_NO;
+         refs := 0;
+         is_valid := 1;
          varspez:=tvarspez(readbyte);
          varspez:=tvarspez(readbyte);
          if read_member then
          if read_member then
            address:=readlong
            address:=readlong
@@ -873,60 +894,37 @@
          islocalcopy:=false;
          islocalcopy:=false;
 {$endif}
 {$endif}
          definition:=readdefref;
          definition:=readdefref;
-         refs := 0;
-         is_valid := 1;
-         { symbols which are load are never candidates for a register }
-         var_options:=0;
-         { was regable:=false; }
-         reg:=R_NO;
-      end;
-
-    constructor tvarsym.init_C(const n,mangled : string;p : pdef);
-
-      begin
-      { The tvarsym is necessary for 0.99.5 (PFV) }
-         tvarsym.init(n,p);
-         var_options:=var_options or vo_is_C_var;
-         { C prefix not allways added moved to
-           pdecl PM }
-         _mangledname:=strpnew(mangled);
-      end;
-
-    constructor tvarsym.load_C;
-
-      begin
-      { Adding tvarsym removes the warning }
-         tvarsym.load;
-         typ:=varsym;
          var_options:=readbyte;
          var_options:=readbyte;
-         _mangledname:=strpnew(readstring);
+         if (var_options and vo_is_C_var)<>0 then
+           setmangledname(readstring);
       end;
       end;
 
 
-    procedure tvarsym.deref;
 
 
+    procedure tvarsym.deref;
       begin
       begin
          resolvedef(definition);
          resolvedef(definition);
       end;
       end;
 
 
-    procedure tvarsym.write;
 
 
+    procedure tvarsym.write;
       begin
       begin
          tsym.write;
          tsym.write;
          writebyte(byte(varspez));
          writebyte(byte(varspez));
-
          if read_member then
          if read_member then
           writelong(address);
           writelong(address);
-
          writedefref(definition);
          writedefref(definition);
+         { symbols which are load are never candidates for a register,
+           turn of the regable }
+         writebyte(var_options and (not vo_regable));
          if (var_options and vo_is_C_var)<>0 then
          if (var_options and vo_is_C_var)<>0 then
-           begin
-              writebyte(var_options);
-              writestring(mangledname);
-           end;
-         if (var_options and vo_is_C_var)<>0 then
-           current_ppu^.writeentry(ibvarsym_C)
-         else
-           current_ppu^.writeentry(ibvarsym);
+            writestring(mangledname);
+         current_ppu^.writeentry(ibvarsym);
+      end;
+
+
+    procedure tvarsym.setmangledname(const s : string);
+      begin
+        _mangledname:=strpnew(s);
       end;
       end;
 
 
 
 
@@ -952,6 +950,7 @@
          mangledname:=prefix+name;
          mangledname:=prefix+name;
       end;
       end;
 
 
+
 {$ifndef VALUEPARA}
 {$ifndef VALUEPARA}
     function tvarsym.getsize : longint;
     function tvarsym.getsize : longint;
       begin
       begin
@@ -1804,7 +1803,10 @@
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.62  1998-11-27 14:50:48  peter
+  Revision 1.63  1998-11-28 16:20:56  peter
+    + support for dll variables
+
+  Revision 1.62  1998/11/27 14:50:48  peter
     + open strings, $P switch support
     + open strings, $P switch support
 
 
   Revision 1.61  1998/11/18 15:44:18  peter
   Revision 1.61  1998/11/18 15:44:18  peter

+ 12 - 8
compiler/symsymh.inc

@@ -185,18 +185,19 @@
           varspez      : tvarspez;  { sets the type of access }
           varspez      : tvarspez;  { sets the type of access }
           is_valid     : byte;
           is_valid     : byte;
           constructor init(const n : string;p : pdef);
           constructor init(const n : string;p : pdef);
-          constructor load;
+          constructor init_dll(const n : string;p : pdef);
           constructor init_C(const n,mangled : string;p : pdef);
           constructor init_C(const n,mangled : string;p : pdef);
-          constructor load_C;
+          constructor load;
           destructor done;virtual;
           destructor done;virtual;
-          function mangledname : string;virtual;
+          procedure write;virtual;
+          procedure deref;virtual;
+          procedure setmangledname(const s : string);
+          function  mangledname : string;virtual;
           procedure insert_in_data;virtual;
           procedure insert_in_data;virtual;
-          function getsize : longint;
+          function  getsize : longint;
 {$ifdef VALUEPARA}
 {$ifdef VALUEPARA}
-          function getpushsize : longint;
+          function  getpushsize : longint;
 {$endif}
 {$endif}
-          procedure write;virtual;
-          procedure deref;virtual;
 {$ifdef GDB}
 {$ifdef GDB}
           function stabstring : pchar;virtual;
           function stabstring : pchar;virtual;
           procedure concatstabto(asmlist : paasmoutput);virtual;
           procedure concatstabto(asmlist : paasmoutput);virtual;
@@ -326,7 +327,10 @@
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.8  1998-11-18 15:44:19  peter
+  Revision 1.9  1998-11-28 16:20:57  peter
+    + support for dll variables
+
+  Revision 1.8  1998/11/18 15:44:19  peter
     * VALUEPARA for tp7 compatible value parameters
     * VALUEPARA for tp7 compatible value parameters
 
 
   Revision 1.7  1998/11/16 10:13:50  peter
   Revision 1.7  1998/11/16 10:13:50  peter

+ 88 - 43
compiler/win_targ.pas

@@ -32,6 +32,7 @@ unit win_targ;
     timportlibwin32=object(timportlib)
     timportlibwin32=object(timportlib)
       procedure preparelib(const s:string);virtual;
       procedure preparelib(const s:string);virtual;
       procedure importprocedure(const func,module:string;index:longint;const name:string);virtual;
       procedure importprocedure(const func,module:string;index:longint;const name:string);virtual;
+      procedure importvariable(const varname,module:string;const name:string);virtual;
       procedure generatelib;virtual;
       procedure generatelib;virtual;
       procedure generatesmartlib;
       procedure generatesmartlib;
     end;
     end;
@@ -130,10 +131,35 @@ unit win_targ;
       end;
       end;
 
 
     procedure timportlibwin32.importprocedure(const func,module : string;index : longint;const name : string);
     procedure timportlibwin32.importprocedure(const func,module : string;index : longint;const name : string);
+      var
+         hp1 : pimportlist;
+         hp2 : pimported_item;
+         hs  : string;
+      begin
+         hs:=SplitName(module);
+         { search for the module }
+         hp1:=pimportlist(current_module^.imports^.first);
+         while assigned(hp1) do
+           begin
+              if hs=hp1^.dllname^ then
+                break;
+              hp1:=pimportlist(hp1^.next);
+           end;
+         { generate a new item ? }
+         if not(assigned(hp1)) then
+           begin
+              hp1:=new(pimportlist,init(hs));
+              current_module^.imports^.concat(hp1);
+           end;
+         hp2:=new(pimported_item,init(func,name,index));
+         hp1^.imported_items^.concat(hp2);
+      end;
+
 
 
+    procedure timportlibwin32.importvariable(const varname,module:string;const name:string);
       var
       var
          hp1 : pimportlist;
          hp1 : pimportlist;
-         hp2 : pimported_procedure;
+         hp2 : pimported_item;
          hs  : string;
          hs  : string;
       begin
       begin
          hs:=SplitName(module);
          hs:=SplitName(module);
@@ -151,15 +177,15 @@ unit win_targ;
               hp1:=new(pimportlist,init(hs));
               hp1:=new(pimportlist,init(hs));
               current_module^.imports^.concat(hp1);
               current_module^.imports^.concat(hp1);
            end;
            end;
-         hp2:=new(pimported_procedure,init(func,name,index));
-         hp1^.imported_procedures^.concat(hp2);
+         hp2:=new(pimported_item,init_var(varname,name));
+         hp1^.imported_items^.concat(hp2);
       end;
       end;
 
 
 
 
     procedure timportlibwin32.generatesmartlib;
     procedure timportlibwin32.generatesmartlib;
       var
       var
          hp1 : pimportlist;
          hp1 : pimportlist;
-         hp2 : pimported_procedure;
+         hp2 : pimported_item;
          lhead,lname,lcode,
          lhead,lname,lcode,
          lidata4,lidata5 : plabel;
          lidata4,lidata5 : plabel;
          r : preference;
          r : preference;
@@ -209,26 +235,29 @@ unit win_targ;
               importssection^.concat(new(pai_string,init(hp1^.dllname^+target_os.sharedlibext+#0)));
               importssection^.concat(new(pai_string,init(hp1^.dllname^+target_os.sharedlibext+#0)));
 
 
               { create procedures }
               { create procedures }
-              hp2:=pimported_procedure(hp1^.imported_procedures^.first);
+              hp2:=pimported_item(hp1^.imported_items^.first);
               while assigned(hp2) do
               while assigned(hp2) do
                 begin
                 begin
                   { insert cuts }
                   { insert cuts }
                   importssection^.concat(new(pai_cut,init));
                   importssection^.concat(new(pai_cut,init));
                   { create indirect jump }
                   { create indirect jump }
-                  getlabel(lcode);
-                  new(r);
-                  reset_reference(r^);
-                  r^.symbol:=stringdup(lab2str(lcode));
-                  { place jump in codesegment, insert a code section in the
-                    importsection to reduce the amount of .s files (PFV) }
-                  importssection^.concat(new(pai_section,init(sec_code)));
+                  if not hp2^.is_var then
+                   begin
+                     getlabel(lcode);
+                     new(r);
+                     reset_reference(r^);
+                     r^.symbol:=stringdup(lab2str(lcode));
+                     { place jump in codesegment, insert a code section in the
+                       importsection to reduce the amount of .s files (PFV) }
+                     importssection^.concat(new(pai_section,init(sec_code)));
 {$IfDef GDB}
 {$IfDef GDB}
-                  if (cs_debuginfo in aktmoduleswitches) then
-                   importssection^.concat(new(pai_stab_function_name,init(nil)));
+                     if (cs_debuginfo in aktmoduleswitches) then
+                      importssection^.concat(new(pai_stab_function_name,init(nil)));
 {$EndIf GDB}
 {$EndIf GDB}
-                  importssection^.concat(new(pai_align,init_op(4,$90)));
-                  importssection^.concat(new(pai_symbol,init_global(hp2^.func^)));
-                  importssection^.concat(new(pai386,op_ref(A_JMP,S_NO,r)));
+                     importssection^.concat(new(pai_align,init_op(4,$90)));
+                     importssection^.concat(new(pai_symbol,init_global(hp2^.func^)));
+                     importssection^.concat(new(pai386,op_ref(A_JMP,S_NO,r)));
+                   end;
                   { create head link }
                   { create head link }
                   importssection^.concat(new(pai_section,init_idata(7)));
                   importssection^.concat(new(pai_section,init_idata(7)));
                   importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(lhead)))));
                   importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(lhead)))));
@@ -238,7 +267,10 @@ unit win_targ;
                   importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(hp2^.lab)))));
                   importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(hp2^.lab)))));
                   { add jump field to importsection }
                   { add jump field to importsection }
                   importssection^.concat(new(pai_section,init_idata(5)));
                   importssection^.concat(new(pai_section,init_idata(5)));
-                  importssection^.concat(new(pai_label,init(lcode)));
+                  if hp2^.is_var then
+                   importssection^.concat(new(pai_symbol,init_global(hp2^.func^)))
+                  else
+                   importssection^.concat(new(pai_label,init(lcode)));
                   importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(hp2^.lab)))));
                   importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(hp2^.lab)))));
                   { finally the import information }
                   { finally the import information }
                   importssection^.concat(new(pai_section,init_idata(6)));
                   importssection^.concat(new(pai_section,init_idata(6)));
@@ -246,7 +278,7 @@ unit win_targ;
                   importssection^.concat(new(pai_const,init_16bit(hp2^.ordnr)));
                   importssection^.concat(new(pai_const,init_16bit(hp2^.ordnr)));
                   importssection^.concat(new(pai_string,init(hp2^.name^+#0)));
                   importssection^.concat(new(pai_string,init(hp2^.name^+#0)));
 
 
-                  hp2:=pimported_procedure(hp2^.next);
+                  hp2:=pimported_item(hp2^.next);
                 end;
                 end;
               hp1:=pimportlist(hp1^.next);
               hp1:=pimportlist(hp1^.next);
            end;
            end;
@@ -256,7 +288,7 @@ unit win_targ;
     procedure timportlibwin32.generatelib;
     procedure timportlibwin32.generatelib;
       var
       var
          hp1 : pimportlist;
          hp1 : pimportlist;
-         hp2 : pimported_procedure;
+         hp2 : pimported_item;
          l1,l2,l3,l4 : plabel;
          l1,l2,l3,l4 : plabel;
          r : preference;
          r : preference;
       begin
       begin
@@ -302,12 +334,12 @@ unit win_targ;
               importssection^.concat(new(pai_section,init_idata(4)));
               importssection^.concat(new(pai_section,init_idata(4)));
               importssection^.concat(new(pai_label,init(l2)));
               importssection^.concat(new(pai_label,init(l2)));
 
 
-              hp2:=pimported_procedure(hp1^.imported_procedures^.first);
+              hp2:=pimported_item(hp1^.imported_items^.first);
               while assigned(hp2) do
               while assigned(hp2) do
                 begin
                 begin
                    getlabel(plabel(hp2^.lab));
                    getlabel(plabel(hp2^.lab));
                    importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(hp2^.lab)))));
                    importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(hp2^.lab)))));
-                   hp2:=pimported_procedure(hp2^.next);
+                   hp2:=pimported_item(hp2^.next);
                 end;
                 end;
               { finalize the names ... }
               { finalize the names ... }
               importssection^.concat(new(pai_const,init_32bit(0)));
               importssection^.concat(new(pai_const,init_32bit(0)));
@@ -315,36 +347,43 @@ unit win_targ;
               { then the addresses and create also the indirect jump }
               { then the addresses and create also the indirect jump }
               importssection^.concat(new(pai_section,init_idata(5)));
               importssection^.concat(new(pai_section,init_idata(5)));
               importssection^.concat(new(pai_label,init(l3)));
               importssection^.concat(new(pai_label,init(l3)));
-              hp2:=pimported_procedure(hp1^.imported_procedures^.first);
+              hp2:=pimported_item(hp1^.imported_items^.first);
               while assigned(hp2) do
               while assigned(hp2) do
                 begin
                 begin
-                   getdatalabel(l4);
-                   { create indirect jump }
-                   new(r);
-                   reset_reference(r^);
-                   r^.symbol:=stringdup(lab2str(l4));
-                   { place jump in codesegment }
-                   codesegment^.concat(new(pai_align,init_op(4,$90)));
-                   codesegment^.concat(new(pai_symbol,init_global(hp2^.func^)));
-                   codesegment^.concat(new(pai386,op_ref(A_JMP,S_NO,r)));
-                   { add jump field to importsection }
-                   importssection^.concat(new(pai_label,init(l4)));
+                   if not hp2^.is_var then
+                    begin
+                      getdatalabel(l4);
+                      { create indirect jump }
+                      new(r);
+                      reset_reference(r^);
+                      r^.symbol:=stringdup(lab2str(l4));
+                      { place jump in codesegment }
+                      codesegment^.concat(new(pai_align,init_op(4,$90)));
+                      codesegment^.concat(new(pai_symbol,init_global(hp2^.func^)));
+                      codesegment^.concat(new(pai386,op_ref(A_JMP,S_NO,r)));
+                      { add jump field to importsection }
+                      importssection^.concat(new(pai_label,init(l4)));
+                    end
+                   else
+                    begin
+                      importssection^.concat(new(pai_symbol,init_global(hp2^.func^)));
+                    end;
                    importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(hp2^.lab)))));
                    importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(hp2^.lab)))));
-                   hp2:=pimported_procedure(hp2^.next);
+                   hp2:=pimported_item(hp2^.next);
                 end;
                 end;
               { finalize the addresses }
               { finalize the addresses }
               importssection^.concat(new(pai_const,init_32bit(0)));
               importssection^.concat(new(pai_const,init_32bit(0)));
 
 
               { finally the import information }
               { finally the import information }
               importssection^.concat(new(pai_section,init_idata(6)));
               importssection^.concat(new(pai_section,init_idata(6)));
-              hp2:=pimported_procedure(hp1^.imported_procedures^.first);
+              hp2:=pimported_item(hp1^.imported_items^.first);
               while assigned(hp2) do
               while assigned(hp2) do
                 begin
                 begin
                    importssection^.concat(new(pai_label,init(hp2^.lab)));
                    importssection^.concat(new(pai_label,init(hp2^.lab)));
                    { the ordinal number }
                    { the ordinal number }
                    importssection^.concat(new(pai_const,init_16bit(hp2^.ordnr)));
                    importssection^.concat(new(pai_const,init_16bit(hp2^.ordnr)));
                    importssection^.concat(new(pai_string,init(hp2^.name^+#0)));
                    importssection^.concat(new(pai_string,init(hp2^.name^+#0)));
-                   hp2:=pimported_procedure(hp2^.next);
+                   hp2:=pimported_item(hp2^.next);
                 end;
                 end;
               { create import dll name }
               { create import dll name }
               importssection^.concat(new(pai_section,init_idata(7)));
               importssection^.concat(new(pai_section,init_idata(7)));
@@ -411,25 +450,27 @@ unit win_targ;
          peheaderpos : longint;
          peheaderpos : longint;
 
 
       begin
       begin
+         { when -s is used quit, because there is no .exe }
+         if cs_link_extern in aktglobalswitches then
+          exit;
+         { open file }
          assign(f,n);
          assign(f,n);
-         {$i-}
-         reset(f,1);
+         {$I-}
+          reset(f,1);
          if ioresult<>0 then
          if ioresult<>0 then
            Message1(execinfo_f_cant_open_executable,n);
            Message1(execinfo_f_cant_open_executable,n);
+         { read headers }
          blockread(f,dosheader,sizeof(tdosheader));
          blockread(f,dosheader,sizeof(tdosheader));
          peheaderpos:=dosheader.e_lfanew;
          peheaderpos:=dosheader.e_lfanew;
          seek(f,peheaderpos);
          seek(f,peheaderpos);
          blockread(f,peheader,sizeof(tpeheader));
          blockread(f,peheader,sizeof(tpeheader));
-
          { write info }
          { write info }
          Message1(execinfo_x_codesize,tostr(peheader.SizeOfCode));
          Message1(execinfo_x_codesize,tostr(peheader.SizeOfCode));
          Message1(execinfo_x_initdatasize,tostr(peheader.SizeOfInitializedData));
          Message1(execinfo_x_initdatasize,tostr(peheader.SizeOfInitializedData));
          Message1(execinfo_x_uninitdatasize,tostr(peheader.SizeOfUninitializedData));
          Message1(execinfo_x_uninitdatasize,tostr(peheader.SizeOfUninitializedData));
          Message1(execinfo_x_stackreserve,tostr(peheader.SizeOfStackReserve));
          Message1(execinfo_x_stackreserve,tostr(peheader.SizeOfStackReserve));
          Message1(execinfo_x_stackcommit,tostr(peheader.SizeOfStackCommit));
          Message1(execinfo_x_stackcommit,tostr(peheader.SizeOfStackCommit));
-
          { change the header }
          { change the header }
-
          { sub system }
          { sub system }
          { gui=2 }
          { gui=2 }
          { cui=3 }
          { cui=3 }
@@ -442,12 +483,16 @@ unit win_targ;
          close(f);
          close(f);
          if ioresult<>0 then
          if ioresult<>0 then
            Message1(execinfo_f_cant_process_executable,n);
            Message1(execinfo_f_cant_process_executable,n);
+         {$I+}
       end;
       end;
 
 
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.13  1998-10-29 11:35:54  florian
+  Revision 1.14  1998-11-28 16:21:00  peter
+    + support for dll variables
+
+  Revision 1.13  1998/10/29 11:35:54  florian
     * some dll support for win32
     * some dll support for win32
     * fixed assembler writing for PalmOS
     * fixed assembler writing for PalmOS