Selaa lähdekoodia

+ APPTYPE support under OS/2, app_fs, GetEnvPChar for OS/2

Tomas Hajny 24 vuotta sitten
vanhempi
commit
ee51dcc980

+ 1 - 0
compiler/errore.msg

@@ -1933,6 +1933,7 @@ option_help_pages=11025_[
 3*2WB<x>_Set Image base to Hexadecimal <x> value
 3*2WC_Specify console type application
 3*2WD_Use DEFFILE to export functions of DLL or EXE
+3*2WF_Specify full-screen type application (OS/2 only)
 3*2WG_Specify graphic type application
 3*2WN_Do not generate relocation code (necessary for debugging)
 3*2WR_Generate relocation code

+ 26 - 2
compiler/globals.pas

@@ -33,6 +33,9 @@ interface
 {$ifdef unix}
       linux,
 {$endif}
+{$ifdef os2}
+      doscalls,
+{$endif}
 {$ifdef Delphi}
       sysutils,
       dmisc,
@@ -191,7 +194,7 @@ interface
        debugstop,
        only_one_pass : boolean;
 {$EndIf EXTDEBUG}
-       { windows application type }
+       { windows / OS/2 application type }
        apptype : tapptype;
 
     const
@@ -948,6 +951,10 @@ implementation
         i,len : longint;
         hp,p,p2 : pchar;
       {$endif}
+      {$ifdef os2}
+      var
+        P1, P2: PChar;
+      {$endif}
       begin
       {$ifdef unix}
         GetEnvPchar:=Linux.Getenv(envname);
@@ -975,6 +982,18 @@ implementation
         FreeEnvironmentStrings(p);
         {$define GETENVOK}
       {$endif}
+      {$ifdef os2}
+        P1 := StrPNew (EnvName);
+        if Assigned (P1) then
+        begin
+         if DosCalls.DosScanEnv (P1, P2) = 0 then
+          GetEnvPChar := P2
+         else
+          GetEnvPChar := nil;
+         StrDispose (P1);
+        end else GetEnvPChar := nil;
+        {$define GETENVOK}
+      {$endif}
       {$ifdef GETENVOK}
         {$undef GETENVOK}
       {$else}
@@ -986,7 +1005,9 @@ implementation
     procedure FreeEnvPChar(p:pchar);
       begin
       {$ifndef unix}
+       {$ifndef os2}
         StrDispose(p);
+       {$endif}
       {$endif}
       end;
 
@@ -1278,7 +1299,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.23  2001-01-13 00:03:41  peter
+  Revision 1.24  2001-01-20 18:32:52  hajny
+    + APPTYPE support under OS/2, app_fs, GetEnvPChar for OS/2
+
+  Revision 1.23  2001/01/13 00:03:41  peter
     * fixed findexe to also support already extension in name
 
   Revision 1.22  2000/12/26 15:57:25  peter

+ 6 - 3
compiler/globtype.pas

@@ -147,9 +147,9 @@ interface
        );
        tmodeswitches = set of tmodeswitch;
 
-       { win32 sub system }
+       { win32 & OS/2 application types }
        tapptype = (app_none,
-         app_gui,app_cui
+         app_gui,app_cui,app_fs
        );
 
        { interface types }
@@ -219,7 +219,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.10  2000-11-29 00:30:30  florian
+  Revision 1.11  2001-01-20 18:32:52  hajny
+    + APPTYPE support under OS/2, app_fs, GetEnvPChar for OS/2
+
+  Revision 1.10  2000/11/29 00:30:30  florian
     * unused units removed from uses clause
     * some changes for widestrings
 

+ 1 - 1
compiler/msgidx.inc

@@ -572,7 +572,7 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 32076;
+  MsgTxtSize = 32131;
 
   MsgIdxMax : array[1..20] of longint=(
     17,59,174,37,41,41,86,14,35,40,

+ 7 - 6
compiler/msgtxt.inc

@@ -762,24 +762,25 @@ const msgtxt : array[0..000133,1..240] of char=(
   '3*2WB<x','>_Set Image base to Hexadecimal <x> value'#010+
   '3*2WC_Specify console type application'#010+
   '3*2WD_Use DEFFILE to export functions of DLL or EXE'#010+
+  '3*2WF_Specify full-screen type application (OS/2 only)'#010+
   '3*2WG_Specify graphic type application'#010+
-  '3*2WN_Do not generate relocation code (necessary for debugging)'#010+
-  '3*2W','R_Generate relocation code'#010+
+  '3*2WN_Do not ','generate relocation code (necessary for debugging)'#010+
+  '3*2WR_Generate relocation code'#010+
   '6*1A<x>_output format'#010+
   '6*2Aas_Unix o-file using GNU AS'#010+
   '6*2Agas_GNU Motorola assembler'#010+
   '6*2Amit_MIT Syntax (old GAS)'#010+
   '6*2Amot_Standard Motorola assembler'#010+
-  '6*1O_optimizations:'#010+
+  '6*1O_opt','imizations:'#010+
   '6*2Oa_turn on the optimizer'#010+
-  '6*2Og_generate ','smaller code'#010+
+  '6*2Og_generate smaller code'#010+
   '6*2OG_generate faster code (default)'#010+
   '6*2Ox_optimize maximum (still BUGGY!!!)'#010+
   '6*2O2_set target processor to a MC68020+'#010+
   '6*1R<x>_assembler reading style:'#010+
-  '6*2RMOT_read motorola style assembler'#010+
+  '6*2RMOT_read motorola',' style assembler'#010+
   '6*1T<x>_Target operating system:'#010+
-  '6*2TA','MIGA_Commodore Amiga'#010+
+  '6*2TAMIGA_Commodore Amiga'#010+
   '6*2TATARI_Atari ST/STe/TT'#010+
   '6*2TMACOS_Macintosh m68k'#010+
   '6*2TLINUX_Linux-68k'#010+

+ 5 - 1
compiler/options.pas

@@ -748,6 +748,7 @@ begin
                              end;
                         'C': apptype:=app_cui;
                         'D': ForceDeffileForExport:=true;
+                        'F': apptype:=app_fs;
                         'G': apptype:=app_gui;
                         'N': begin
                                RelocSection:=false;
@@ -1517,7 +1518,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.26  2001-01-12 19:21:09  peter
+  Revision 1.27  2001-01-20 18:36:51  hajny
+    + APPTYPE support under OS/2, app_fs, GetEnvPChar for OS/2
+
+  Revision 1.26  2001/01/12 19:21:09  peter
     * fixed writing of quickinfo when no ppc386.cfg is available
 
   Revision 1.25  2001/01/05 17:36:57  florian

+ 8 - 2
compiler/scandir.inc

@@ -1082,7 +1082,8 @@ const
          hs : string;
 
       begin
-        if target_info.target<>target_i386_win32 then
+        if (target_info.target<>target_i386_win32)
+                                 and (target_info.target<>target_i386_os2) then
           Message(scan_w_app_type_not_support);
         if not current_module.in_global then
           Message(scan_w_switch_is_global)
@@ -1094,6 +1095,8 @@ const
                apptype:=app_gui
              else if hs='CONSOLE' then
                apptype:=app_cui
+             else if (hs='FS') and (target_info.target=target_i386_os2) then
+               apptype:=app_fs
              else
                Message1(scan_w_unsupported_app_type,hs);
           end;
@@ -1390,7 +1393,10 @@ const
 
 {
   $Log$
-  Revision 1.16  2001-01-13 00:09:21  peter
+  Revision 1.17  2001-01-20 18:32:52  hajny
+    + APPTYPE support under OS/2, app_fs, GetEnvPChar for OS/2
+
+  Revision 1.16  2001/01/13 00:09:21  peter
     * made Pavel O. happy ;)
 
   Revision 1.15  2000/12/25 00:07:28  peter

+ 12 - 8
compiler/t_os2.pas

@@ -365,7 +365,7 @@ begin
   with Info do
    begin
      ExeCmd[1]:='ld $OPT -o $EXE @$RES';
-     ExeCmd[2]:='emxbind -b $STRIP $PM $RSRC -k$STACKKB -h$HEAPMB -o $EXE.exe $EXE -aim -s$DOSHEAPKB';
+     ExeCmd[2]:='emxbind -b $STRIP $APPTYPE $RSRC -k$STACKKB -h$HEAPMB -o $EXE.exe $EXE -aim -s$DOSHEAPKB';
    end;
 end;
 
@@ -438,7 +438,7 @@ var
   cmdstr  : string;
   success : boolean;
   i       : longint;
-  PMStr,
+  AppTypeStr,
   StripStr: string[40];
   RsrcStr : string;
 begin
@@ -450,10 +450,11 @@ begin
    StripStr := '-s'
   else
    StripStr := '';
-  if usewindowapi then
-   PMStr := '-p'
-  else
-   PMStr := '';
+  if (usewindowapi) or (AppType = app_gui) then
+   AppTypeStr := '-p'
+  else if AppType = app_fs then
+   AppTypeStr := '-f'
+  else AppTypeStr := '-w';
   if not (Current_module.ResourceFiles.Empty) then
    RsrcStr := '-r ' + Current_module.ResourceFiles.GetFirst
   else
@@ -478,7 +479,7 @@ begin
          same memory pool. The heap grows upwards, the stack grows downwards.}
         Replace(cmdstr,'$DOSHEAPKB',tostr((stacksize+maxheapsize+1023) shr 10));
         Replace(cmdstr,'$STRIP',StripStr);
-        Replace(cmdstr,'$PM',PMStr);
+        Replace(cmdstr,'$APPTYPE',AppTypeStr);
         Replace(cmdstr,'$RES',outputexedir+Info.ResName);
         Replace(cmdstr,'$OPT',Info.ExtraOptions);
         Replace(cmdstr,'$RSRC',RsrcStr);
@@ -502,7 +503,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.6  2000-12-25 00:07:30  peter
+  Revision 1.7  2001-01-20 18:32:52  hajny
+    + APPTYPE support under OS/2, app_fs, GetEnvPChar for OS/2
+
+  Revision 1.6  2000/12/25 00:07:30  peter
     + new tlinkedlist class (merge of old tstringqueue,tcontainer and
       tlinkedlist objects)