* GetEnv correction, better PM support, ...

rtl/os2/dos.pas

@@ -943,58 +943,53 @@ begin
 {$ASMMODE INTEL}
  asm
   cld
-  mov ecx, EnvC
-  mov edi, EnvP
-  mov edi, [edi]
+  mov edi, Environment
   lea esi, _EnvVar
   xor eax, eax
   lodsb
 @NewVar:
-  push ecx
-  push eax
-  push esi
-  mov ecx, -1
-  mov edx, edi
-  mov al, '='
+  cmp byte ptr [edi], 0
+  jz @Stop
+  push eax        { eax contains length of searched variable name }
+  push esi        { esi points to the beginning of the variable name }
+  mov ecx, -1     { our character ('=' - see below) _must_ be found }
+  mov edx, edi    { pointer to beginning of variable name saved in edx }
+  mov al, '='     { searching until '=' (end of variable name) }
   repne
-  scasb
-  neg ecx
-  dec ecx
-  dec ecx
-  pop esi
-  pop eax
-  push eax
+  scasb           { scan until '=' not found }
+  neg ecx         { what was the name length? }
+  dec ecx         { corrected }
+  dec ecx         { exclude the '=' character }
+  pop esi         { restore pointer to beginning of variable name }
+  pop eax         { restore length of searched variable name }
+  push eax        { and save both of them again for later use }
   push esi
-  cmp ecx, eax
-  jnz @NotEqual
-  xchg edx, edi
+  cmp ecx, eax    { compare length of searched variable name with name }
+  jnz @NotEqual   { ... of currently found variable, jump if different }
+  xchg edx, edi   { pointer to current variable name restored in edi }
   repe
-  cmpsb
-  xchg edx, edi
-  jz @Equal
+  cmpsb           { compare till the end of variable name }
+  xchg edx, edi   { pointer to beginning of variable contents in edi }
+  jz @Equal       { finish if they're equal }
 @NotEqual:
-  xor eax, eax
-  mov ecx, -1
+  xor eax, eax    { look for 00h }
+  mov ecx, -1     { it _must_ be found }
   repne
-  scasb
-  pop esi
-  pop eax
-  pop ecx
-  dec ecx
-  jecxz @Stop
-  jmp @NewVar
+  scasb           { scan until found }
+  pop esi         { restore pointer to beginning of variable name }
+  pop eax         { restore length of searched variable name }
+  jmp @NewVar     { ... or continue with new variable otherwise }
 @Stop:
-  mov P, ecx
+  xor eax, eax
+  mov P, eax      { Not found - return nil }
   jmp @End
 @Equal:
-  pop esi
+  pop esi         { restore the stack position }
   pop eax
-  pop ecx  
-  mov P, edi
+  mov P, edi      { place pointer to variable contents in P }
 @End:
  end;
  GetEnv := StrPas (P);
-end;
 {$ASMMODE ATT}
 
 procedure fsplit(path:pathstr;var dir:dirstr;var name:namestr;
@@ -1218,7 +1213,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.20  2002-11-18 19:51:00  hajny
+  Revision 1.21  2002-12-07 19:17:13  hajny
+    * GetEnv correction, better PM support, ...
+
+  Revision 1.20  2002/11/18 19:51:00  hajny
     * another bunch of type corrections
 
   Revision 1.19  2002/09/07 16:01:24  peter

rtl/os2/system.pas

@@ -109,6 +109,18 @@ var
   argv  : ppchar;external name '_argv';
   envp  : ppchar;external name '_environ';
 
+(* Pointer to the block of environment variables - used e.g. in unit Dos. *)
+  Environment: PChar;
+
+var
+(* Type / run mode of the current process: *)
+(* 0 .. full screen OS/2 session           *)
+(* 1 .. DOS session                        *)
+(* 2 .. VIO windowable OS/2 session        *)
+(* 3 .. Presentation Manager OS/2 session  *)
+(* 4 .. detached (background) OS/2 process *)
+  ApplicationType: cardinal;
+
 implementation
 
 {$I system.inc}
@@ -117,6 +129,8 @@ var
     heap_base: pointer; external name '__heap_base';
     heap_brk: pointer; external name '__heap_brk';
     heap_end: pointer; external name '__heap_end';
+
+(* Maximum heap size - only used if heap is allocated as continuous block. *)
 {$IFDEF CONTHEAP}
     BrkLimit: cardinal;
 {$ENDIF CONTHEAP}
@@ -125,6 +139,14 @@ procedure DosGetInfoBlocks (PATIB: PPThreadInfoBlock;
                             PAPIB: PPProcessInfoBlock); cdecl;
                             external 'DOSCALLS' index 312;
 
+function DosLoadModule (ObjName: PChar; ObjLen: cardinal; DLLName: PChar;
+                                         var Handle: cardinal): longint; cdecl;
+external 'DOSCALLS' index 318;
+
+function DosQueryProcAddr (Handle, Ordinal: cardinal; ProcName: PChar;
+                                         var Address: pointer): longint; cdecl;
+external 'DOSCALLS' index 321;
+
 function DosSetRelMaxFH (var ReqCount, CurMaxFH: longint): longint; cdecl;
 external 'DOSCALLS' index 382;
 
@@ -134,9 +156,9 @@ external 'DOSCALLS' index 255;
 function DosSetDefaultDisk (DiskNum:longint): longint; cdecl;
 external 'DOSCALLS' index 220;
 
-{ This is not real prototype, but its close enough  }
-{ for us. (The 2nd parameter is acutally a pointer) }
-{ to a structure.                                   }
+{ This is not real prototype, but is close enough }
+{ for us (the 2nd parameter is actually a pointer }
+{ to a structure).                                }
 function DosCreateDir( Name : pchar; p : pointer): longint; cdecl;
 external 'DOSCALLS' index 270;
 
@@ -883,12 +905,136 @@ end;
 
 ****************************************************************************}
 
+{****************************************************************************
+                    Error Message writing using messageboxes
+****************************************************************************}
+
+type
+  TWinMessageBox = function (Parent, Owner: cardinal;
+         BoxText, BoxTitle: PChar; Identity, Style: cardinal): cardinal; cdecl;
+  TWinInitialize = function (Options: cardinal): cardinal; cdecl;
+  TWinCreateMsgQueue = function (Handle: cardinal; cmsg: longint): cardinal;
+                                                                         cdecl;
+
+const
+  ErrorBufferLength = 1024;
+  mb_OK = $0000;
+  mb_Error = $0040;
+  mb_Moveable = $4000;
+  MBStyle = mb_OK or mb_Error or mb_Moveable;
+  WinInitialize: TWinInitialize = nil;
+  WinCreateMsgQueue: TWinCreateMsgQueue = nil;
+  WinMessageBox: TWinMessageBox = nil;
+
+var
+  ErrorBuf: array [0..ErrorBufferLength] of char;
+  ErrorLen: longint;
+  PMWinHandle: cardinal;
+
+function ErrorWrite (var F: TextRec): integer;
+{
+  An error message should always end with #13#10#13#10
+}
+var
+  P: PChar;
+  I: longint;
+begin
+  if F.BufPos > 0 then
+   begin
+     if F.BufPos + ErrorLen > ErrorBufferLength then
+       I := ErrorBufferLength - ErrorLen
+     else
+       I := F.BufPos;
+     Move (F.BufPtr^, ErrorBuf [ErrorLen], I);
+     Inc (ErrorLen, I);
+     ErrorBuf [ErrorLen] := #0;
+   end;
+  if ErrorLen > 3 then
+   begin
+     P := @ErrorBuf [ErrorLen];
+     for I := 1 to 4 do
+      begin
+        Dec (P);
+        if not (P^ in [#10, #13]) then
+          break;
+      end;
+   end;
+   if ErrorLen = ErrorBufferLength then
+     I := 4;
+   if (I = 4) then
+    begin
+      WinMessageBox (0, 0, @ErrorBuf, PChar ('Error'), 0, MBStyle);
+      ErrorLen := 0;
+    end;
+  F.BufPos := 0;
+  ErrorWrite := 0;
+end;
+
+function ErrorClose (var F: TextRec): integer;
+begin
+  if ErrorLen > 0 then
+   begin
+     WinMessageBox (0, 0, @ErrorBuf, PChar ('Error'), 0, MBStyle);
+     ErrorLen := 0;
+   end;
+  ErrorLen := 0;
+  ErrorClose := 0;
+end;
+
+function ErrorOpen (var F: TextRec): integer;
+begin
+  TextRec(F).InOutFunc := @ErrorWrite;
+  TextRec(F).FlushFunc := @ErrorWrite;
+  TextRec(F).CloseFunc := @ErrorClose;
+  ErrorOpen := 0;
+end;
+
+
+procedure AssignError (var T: Text);
+begin
+  Assign (T, '');
+  TextRec (T).OpenFunc := @ErrorOpen;
+  Rewrite (T);
+end;
+
+
 procedure SysInitStdIO;
 begin
-    OpenStdIO(Input,fmInput,StdInputHandle);
-    OpenStdIO(Output,fmOutput,StdOutputHandle);
-    OpenStdIO(StdOut,fmOutput,StdOutputHandle);
-    OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+  { Setup stdin, stdout and stderr, for GUI apps redirect stderr,stdout to be
+    displayed in a messagebox }
+(*
+  StdInputHandle := longint(GetStdHandle(cardinal(STD_INPUT_HANDLE)));
+  StdOutputHandle := longint(GetStdHandle(cardinal(STD_OUTPUT_HANDLE)));
+  StdErrorHandle := longint(GetStdHandle(cardinal(STD_ERROR_HANDLE)));
+*)
+  if not IsConsole then
+    begin
+      if (DosLoadModule (nil, 0, 'PMWIN', PMWinHandle) = 0) and
+       (DosQueryProcAddr (PMWinHandle, 789, nil, pointer (WinMessageBox)) = 0)
+                                                                           and
+       (DosQueryProcAddr (PMWinHandle, 763, nil, pointer (WinInitialize)) = 0)
+                                                                           and
+       (DosQueryProcAddr (PMWinHandle, 716, nil, pointer (WinCreateMsgQueue))
+                                                                           = 0)
+        then
+          begin
+            WinInitialize (0);
+            WinCreateMsgQueue (0, 0);
+          end
+        else
+          HandleError (2);
+     AssignError (StdErr);
+     AssignError (StdOut);
+     Assign (Output, '');
+     Assign (Input, '');
+   end
+  else
+   begin
+     OpenStdIO (Input, fmInput, StdInputHandle);
+     OpenStdIO (Output, fmOutput, StdOutputHandle);
+     OpenStdIO (StdOut, fmOutput, StdOutputHandle);
+     OpenStdIO (StdErr, fmOutput, StdErrorHandle);
+   end;
 end;
 
 
@@ -900,10 +1046,10 @@ begin
                                                  else GetFileHandleCount := L2;
 end;
 
-var tib:Pthreadinfoblock;
+var TIB: PThreadInfoBlock;
+    PIB: PProcessInfoBlock;
 
 begin
-    IsConsole := TRUE;
     IsLibrary := FALSE;
     {Determine the operating system we are running on.}
 {$ASMMODE INTEL}
@@ -971,16 +1117,31 @@ begin
     {At 0.9.2, case for enumeration does not work.}
     case os_mode of
         osDOS:
-            stackbottom:=cardinal(heap_brk);     {In DOS mode, heap_brk is also the
-                                 stack bottom.}
+            begin
+                stackbottom:=cardinal(heap_brk);    {In DOS mode, heap_brk is
+                                                     also the stack bottom.}
+                ApplicationType := 1;   (* Running under DOS. *)
+                IsConsole := true;
+(* Currently broken!!! *)
+                Environment := nil;
+            end;
         osOS2:
             begin
-                dosgetinfoblocks(@tib,nil);
-                stackbottom:=cardinal(tib^.stack);
+                DosGetInfoBlocks (@TIB, @PIB);
+                StackBottom := cardinal (TIB^.Stack);
+                Environment := pointer (PIB^.Env);
+                ApplicationType := PIB^.ProcType;
+                IsConsole := ApplicationType <> 3;
             end;
         osDPMI:
-            stackbottom:=0;     {Not sure how to get it, but seems to be
-                                 always zero.}
+            begin
+                stackbottom:=0;     {Not sure how to get it, but seems to be
+                                     always zero.}
+                ApplicationType := 1;   (* Running under DOS. *)
+                IsConsole := true;
+(* Currently broken!!! *)
+                Environment := nil;
+            end;
     end;
     exitproc:=nil;
 
@@ -1009,8 +1170,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.27  2002-11-17 22:31:02  hajny
-    * type corrections (longing x cardinal)
+  Revision 1.28  2002-12-07 19:17:14  hajny
+    * GetEnv correction, better PM support, ...
+
+  Revision 1.27  2002/11/17 22:31:02  hajny
+    * type corrections (longint x cardinal)
 
   Revision 1.26  2002/10/27 14:29:00  hajny
     * heap management (hopefully) fixed