* better readln/writeln

rtl/dos/go32v1/system.pp

@@ -442,6 +442,25 @@ begin
    do_seekend(filerec(f).handle);
 end;
 
+
+function do_isdevice(handle : longint):boolean;assembler;
+asm
+        movl    $0x4400,%eax
+        movl    handle,%ebx
+        pushl   %ebp
+        int     $0x21
+        popl    %ebp
+        jnc     .LDOSSEEK1
+        movw    %ax,inoutres
+	xorl	%edx,%edx
+.LDOSSEEK1:
+	movl	%edx,%eax
+	shrl	$7,%eax
+	andl	$1,%eax
+end;
+
+
+
 {*****************************************************************************
                            UnTyped File Handling
 *****************************************************************************}
@@ -555,20 +574,7 @@ end;
                          SystemUnit Initialization
 *****************************************************************************}
 
-procedure OpenStdIO(var f:text;mode:word;hdl:longint);
-begin
-  Assign(f,'');
-  TextRec(f).Handle:=hdl;
-  TextRec(f).Mode:=mode;
-  TextRec(f).InOutFunc:=@FileInOutFunc;
-  TextRec(f).FlushFunc:=@FileInOutFunc;
-  TextRec(f).Closefunc:=@fileclosefunc;
-end;
-
-
 Begin
-{ Initialize ExitProc }
-  ExitProc:=Nil;
 { to test stack depth }
   loweststack:=maxlongint;
 { Setup heap }
@@ -582,7 +588,10 @@ Begin
 End.
 {
   $Log$
-  Revision 1.4  1998-05-31 14:18:19  peter
+  Revision 1.5  1998-07-01 15:29:56  peter
+    * better readln/writeln
+
+  Revision 1.4  1998/05/31 14:18:19  peter
     * force att or direct assembling
     * cleanup of some files
 

rtl/dos/go32v2/system.pp

@@ -168,7 +168,7 @@ _is_not_lowest:
 {$endif SYSTEMDEBUG}
         movl    __stkbottom,%ebx
         cmpl    %eax,%ebx
-		jae     __short_on_stack
+        jae     __short_on_stack
         popl    %ebx
         popl    %eax
         leave
@@ -244,7 +244,7 @@ end;
               movw dseg,%ax
               movw %ax,%es
               movw sseg,%ax
-			  movw %ax,%ds
+              movw %ax,%ds
               movl %ecx,%eax
               shrl $2,%ecx
               rep
@@ -282,7 +282,7 @@ end;
               rep
               movsb
               incl %esi
-			  incl %edi
+              incl %edi
            .LSEG_MOVE1:
               subl $4,%esi
               subl $4,%edi
@@ -316,11 +316,11 @@ end;
 procedure setup_arguments;
 type  arrayword = array [0..0] of word;
 var psp : word;
-	i,j : byte;
-	quote : char;
-	proxy_s : string[7];
-	tempargv : ppchar;
-	al,proxy_argc,proxy_seg,proxy_ofs,lin : longint;
+    i,j : byte;
+    quote : char;
+    proxy_s : string[7];
+    tempargv : ppchar;
+    al,proxy_argc,proxy_seg,proxy_ofs,lin : longint;
     largs : array[0..127] of pchar;
     rm_argv : ^arrayword;
 begin
@@ -342,7 +342,7 @@ for i:=1 to length(doscmd) do
     quote := #0;
     doscmd[i] := #0;
     largs[argc]:=@doscmd[j];
-	inc(argc);
+    inc(argc);
     j := i+1;
     end else
   if (quote = #0) and ((doscmd[i] = '''') or (doscmd[i]='"')) then
@@ -380,7 +380,7 @@ if (argc > 1) and (far_strlen(get_ds,longint(largs[1])) = 6)  then
     Writeln('proxy command line ');
 {$EndIf SYSTEMDEBUG}
     proxy_argc := atohex(largs[2]);
-	proxy_seg  := atohex(largs[3]);
+    proxy_seg  := atohex(largs[3]);
     proxy_ofs := atohex(largs[4]);
     getmem(rm_argv,proxy_argc*sizeof(word));
     sysseg_move(dos_selector,proxy_seg*16+proxy_ofs, get_ds,longint(rm_argv),proxy_argc*sizeof(word));
@@ -418,7 +418,7 @@ function strcopy(dest,source : pchar) : pchar;
             movl 12(%ebp),%edi
             movl $0xffffffff,%ecx
             xorb %al,%al
-			repne
+            repne
             scasb
             not %ecx
             movl 8(%ebp),%edi
@@ -494,7 +494,7 @@ end;
      begin
         if len > tb_size then runerror(217);
         sysseg_move(dos_selector,tb,get_ds,addr,len);
-	 end;
+     end;
 
     procedure sysrealintr(intnr : word;var regs : trealregs);
 
@@ -653,24 +653,24 @@ begin
   writesize:=0;
   while len > 0 do
    begin
-	 if len>tb_size then
-	  size:=tb_size
-	 else
-	  size:=len;
-	 syscopytodos(addr+writesize,size);
-	 regs.realecx:=size;
-	 regs.realedx:=tb and 15;
-	 regs.realds:=tb shr 4;
-	 regs.realebx:=h;
-	 regs.realeax:=$4000;
-	 sysrealintr($21,regs);
-	 if (regs.realflags and carryflag) <> 0 then
-	  begin
-		InOutRes:=lo(regs.realeax);
-		exit(writesize);
-	  end;
-	 len:=len-size;
-	 writesize:=writesize+size;
+     if len>tb_size then
+      size:=tb_size
+     else
+      size:=len;
+     syscopytodos(addr+writesize,size);
+     regs.realecx:=size;
+     regs.realedx:=tb and 15;
+     regs.realds:=tb shr 4;
+     regs.realebx:=h;
+     regs.realeax:=$4000;
+     sysrealintr($21,regs);
+     if (regs.realflags and carryflag) <> 0 then
+      begin
+        InOutRes:=lo(regs.realeax);
+        exit(writesize);
+      end;
+     len:=len-size;
+     writesize:=writesize+size;
    end;
   Do_Write:=WriteSize
 end;
@@ -702,7 +702,7 @@ begin
         exit;
       end
      else
-	  if regs.realeax<size then
+      if regs.realeax<size then
        begin
          syscopyfromdos(addr+readsize,regs.realeax);
          do_read:=readsize+regs.realeax;
@@ -816,7 +816,7 @@ begin
       fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
       fmclosed : ;
      else
-	  begin
+      begin
         inoutres:=102; {not assigned}
         exit;
       end;
@@ -865,8 +865,8 @@ begin
   sysrealintr($21,regs);
   if (regs.realflags and carryflag) <> 0 then
    begin
-	 InOutRes:=lo(regs.realeax);
-	 exit;
+     InOutRes:=lo(regs.realeax);
+     exit;
    end
   else
    filerec(f).handle:=regs.realeax;
@@ -881,19 +881,33 @@ begin
 { append mode }
   if (flags and $10)<>0 then
    begin
-	 do_seekend(filerec(f).handle);
-	 filerec(f).mode:=fmoutput; {fool fmappend}
+     do_seekend(filerec(f).handle);
+     filerec(f).mode:=fmoutput; {fool fmappend}
    end;
 end;
 
+
+function do_isdevice(handle:longint):boolean;
+var
+  regs : trealregs;
+begin
+  regs.realebx:=handle;
+  regs.realeax:=$4400;
+  sysrealintr($21,regs);
+  do_isdevice:=(regs.realedx and $80)<>0;
+  if (regs.realflags and carryflag) <> 0 then
+   InOutRes:=lo(regs.realeax);
+end;
+
+
 {*****************************************************************************
-						   UnTyped File Handling
+                           UnTyped File Handling
 *****************************************************************************}
 
 {$i file.inc}
 
 {*****************************************************************************
-						   Typed File Handling
+                           Typed File Handling
 *****************************************************************************}
 
 {$i typefile.inc}
@@ -969,8 +983,8 @@ begin
   sysrealintr($21,regs);
   if (regs.realflags and carryflag) <> 0 then
    Begin
-	 InOutRes:=lo(regs.realeax);
-	 exit;
+     InOutRes:=lo(regs.realeax);
+     exit;
    end
   else
    syscopyfromdos(longint(@temp),251);
@@ -978,10 +992,10 @@ begin
   i:=0;
   while (temp[i]<>#0) do
    begin
-	 if temp[i]='/' then
-	  temp[i]:='\';
-	 dir[i+4]:=temp[i];
-	 inc(i);
+     if temp[i]='/' then
+      temp[i]:='\';
+     dir[i+4]:=temp[i];
+     inc(i);
    end;
   dir[2]:=':';
   dir[3]:='\';
@@ -994,16 +1008,16 @@ begin
    begin
    { We need to get the current drive from DOS function 19H  }
    { because the drive was the default, which can be unknown }
-	 regs.realeax:=$1900;
-	 sysrealintr($21,regs);
-	 i:= (regs.realeax and $ff) + ord('A');
-	 dir[1]:=chr(i);
+     regs.realeax:=$1900;
+     sysrealintr($21,regs);
+     i:= (regs.realeax and $ff) + ord('A');
+     dir[1]:=chr(i);
    end;
 end;
 
 
 {*****************************************************************************
-						 SystemUnit Initialization
+                         SystemUnit Initialization
 *****************************************************************************}
 
 {$ifndef RTLLITE}
@@ -1018,20 +1032,7 @@ end;
 {$endif RTLLITE}
 
 
-procedure OpenStdIO(var f:text;mode:word;hdl:longint);
-begin
-  Assign(f,'');
-  TextRec(f).Handle:=hdl;
-  TextRec(f).Mode:=mode;
-  TextRec(f).InOutFunc:=@FileInOutFunc;
-  TextRec(f).FlushFunc:=@FileInOutFunc;
-  TextRec(f).Closefunc:=@fileclosefunc;
-end;
-
-
 Begin
-{ Initialize ExitProc }
-  ExitProc:=Nil;
 { to test stack depth }
   loweststack:=maxlongint;
 { Setup heap }
@@ -1050,7 +1051,10 @@ Begin
 End.
 {
   $Log$
-  Revision 1.8  1998-06-26 08:19:10  pierre
+  Revision 1.9  1998-07-01 15:29:57  peter
+    * better readln/writeln
+
+  Revision 1.8  1998/06/26 08:19:10  pierre
     + all debug in ifdef SYSTEMDEBUG
     + added local arrays :
       opennames names of opened files
@@ -1059,7 +1063,6 @@ End.
       many open files !!
 
   Revision 1.7  1998/06/15 15:17:08  daniel
-
   * RTLLITE conditional added to produce smaller RTL.
 
   Revision 1.6  1998/05/31 14:18:29  peter

rtl/i386/i386.inc

@@ -687,6 +687,7 @@ end ['EAX'];
          end;
       end;
 
+{$IFNDEF NEW_READWRITE}
     procedure f1;[public,alias: 'FLUSH_STDOUT'];
 
       begin
@@ -698,6 +699,7 @@ end ['EAX'];
             popal
          end;
       end;
+{$ENDIF NEW_READWRITE}
 
 
 Function Sptr : Longint;
@@ -728,7 +730,10 @@ end;
 
 {
   $Log$
-  Revision 1.13  1998-06-26 08:20:57  daniel
+  Revision 1.14  1998-07-01 15:29:58  peter
+    * better readln/writeln
+
+  Revision 1.13  1998/06/26 08:20:57  daniel
   - Doerror removed.
 
   Revision 1.12  1998/05/31 14:15:47  peter

rtl/inc/system.inc

@@ -120,11 +120,11 @@ Procedure incr_ansi_ref (P : pointer);[Alias : 'INCR_ANSI_REF'];
 
 
 {****************************************************************************
-		     Run-Time Type Information (RTTI)
+                                                 Run-Time Type Information (RTTI)
 ****************************************************************************}
 
-{$i rtti.inc}
 
+{$i rtti.inc}
 
 {****************************************************************************
                                Math Routines
@@ -332,14 +332,7 @@ Begin
   Halt(0);
 End;
 
-{ Seems not to be used (PFV)
-Procedure Initexception;[Public,Alias: 'INITEXCEPTION'];
-Begin
-  Writeln('Exception occurred during program initialization.');
-  halt(216);
-End;
-}
-{$ifndef RTLLITE}
+
 Procedure dump_stack(bp : Longint);
 
   Procedure dump_frame(addr : Longint);
@@ -365,7 +358,6 @@ Begin
    End;
 End;
 
-{$endif RTLLITE}
 
 Procedure Do_exit;[Public,Alias: '__EXIT'];
 {
@@ -381,23 +373,17 @@ Begin
      exitProc:=nil;
      current_exit();
    End;
-  If erroraddr<>nil Then
+  If DoError Then
    Begin
-{$ifndef RTLLITE}
      Writeln('Run time error  ',Errorcode,' at 0x',hexstr(Longint(Erroraddr),8));
      dump_stack(ErrorBase);
-{$else RTLLITE}
-     writeln('Runerror ',errorcode,' at ',longint(erroraddr));
-{$endif RTLLITE}
    End;
+{$IFNDEF NEW_READWRITE}
   Flush(stderr);
-
+{$ENDIF NEW_READWRITE}
 End;
 
 
-{$ifndef RTLLITE}
-
-
 Type
   PExitProcInfo = ^TExitProcInfo;
   TExitProcInfo = Record
@@ -434,11 +420,12 @@ Begin
   ExitProc:=@DoExitProc;
 End;
 
-{$endif RTLLITE}
-
 {
   $Log$
-  Revision 1.13  1998-06-26 08:21:09  daniel
+  Revision 1.14  1998-07-01 15:29:59  peter
+    * better readln/writeln
+
+  Revision 1.13  1998/06/26 08:21:09  daniel
   - Doerror removed.
 
   Revision 1.12  1998/06/25 14:04:25  peter
@@ -448,7 +435,6 @@ End;
   + RTLLITE directive to compile minimal RTL.
 
   Revision 1.10  1998/06/15 15:16:26  daniel
-
   * RTLLITE conditional added to produce smaller RTL
 
   Revision 1.9  1998/06/10 07:46:45  michael

rtl/inc/text.inc

@@ -1,4 +1,5 @@
-{    $Id$
+{
+    $Id$
     This file is part of the Free Pascal Run time library.
     Copyright (c) 1993,97 by the Free Pascal development team
 
@@ -35,42 +36,54 @@ Begin
 End;
 
 
-Procedure FileInOutFunc(var t:TextRec);
+Procedure FileReadFunc(var t:TextRec);
 Begin
-  Case t.mode Of
-   fmoutput : Do_Write(t.Handle,Longint(t.Bufptr),t.BufPos);
-    fminput : t.BufEnd:=Do_Read(t.Handle,Longint(t.Bufptr),t.BufSize);
-  else
-   RunError(102);
-  End;
+  t.BufEnd:=Do_Read(t.Handle,Longint(t.Bufptr),t.BufSize);
   t.BufPos:=0;
 End;
 
 
+Procedure FileWriteFunc(var t:TextRec);
+Begin
+  Do_Write(t.Handle,Longint(t.Bufptr),t.BufPos);
+  t.BufPos:=0;
+End;
+
+
+
 Procedure FileOpenFunc(var t:TextRec);
 var
   Flags : Longint;
 Begin
-  t.InOutFunc:=@FileInOutFunc;
-  t.FlushFunc:=@FileInOutFunc;
-  t.CloseFunc:=@FileCloseFunc;
   Case t.mode Of
     fmInput : Flags:=$1000;
    fmOutput : Flags:=$1101;
    fmAppend : Flags:=$1011;
+  else
+   RunError(102);
   End;
-  Do_Open(t,PChar(@TextRec(t).Name),Flags);
+  Do_Open(t,PChar(@t.Name),Flags);
+  t.CloseFunc:=@FileCloseFunc;
+  t.FlushFunc:=nil;
+  if t.Mode=fmInput then
+   t.InOutFunc:=@FileReadFunc
+  else
+   begin
+     t.InOutFunc:=@FileWriteFunc;
+   { Only install flushing if its a NOT a file }
+     if Do_Isdevice(t.Handle) then
+      t.FlushFunc:=@FileWriteFunc;
+   end;
 End;
 
 
 Procedure assign(var t:Text;const s:String);
 Begin
   FillChar(t,SizEof(TextRec),0);
+{ only set things that are not zero }
   TextRec(t).Handle:=UnusedHandle;
   TextRec(t).mode:=fmClosed;
   TextRec(t).BufSize:=128;
-  TextRec(t).Bufpos:=0;
-  TextRec(T).Bufend:=0;
   TextRec(t).Bufptr:=@TextRec(t).Buffer;
   TextRec(t).OpenFunc:=@FileOpenFunc;
   Move(s[1],TextRec(t).Name,Length(s));
@@ -93,9 +106,10 @@ Procedure Close(var t : Text);[Public,Alias: 'CLOSE_TEXT',IOCheck];
 Begin
   If (TextRec(t).mode<>fmClosed) Then
    Begin
-     FileFunc(TextRec(t).FlushFunc)(TextRec(t));
+   { Write pending buffer }
+     FileFunc(TextRec(t).InOutFunc)(TextRec(t));
      TextRec(t).mode:=fmClosed;
-     { Only close functions not connected to stdout.}
+   { Only close functions not connected to stdout.}
      If ((TextRec(t).Handle<>StdInputHandle) or
          (TextRec(t).Handle<>StdOutputHandle) or
          (TextRec(t).Handle<>StdErrorHandle)) Then
@@ -116,15 +130,7 @@ Begin
    End;
   End;
   TextRec(t).mode:=word(mode);
-{  If TextRec(t).Name[0]<>#0 Then }
-   FileFunc(TextRec(t).OpenFunc)(TextRec(t))
-{  else
-   Begin
-     TextRec(t).Handle:=defHdl;
-     TextRec(t).InOutFunc:=@FileInOutFunc;
-     TextRec(t).FlushFunc:=@FileInOutFunc;
-     TextRec(t).CloseFunc:=@FileCloseFunc;
-   End; }
+  FileFunc(TextRec(t).OpenFunc)(TextRec(t))
 End;
 
 
@@ -150,7 +156,9 @@ Procedure Flush(var t : Text);[IOCheck];
 Begin
   If TextRec(t).mode<>fmOutput Then
    exit;
-  FileFunc(TextRec(t).FlushFunc)(TextRec(t));
+{ Not the flushfunc but the inoutfunc should be used, becuase that
+  writes the data, flushfunc doesn't need to be assigned }
+  FileFunc(TextRec(t).InOutFunc)(TextRec(t));
 End;
 
 
@@ -342,101 +350,120 @@ End;
                                Write(Ln)
 *****************************************************************************}
 
-Procedure w(Len : Longint;var f : TextRec;var s : String);[Public,Alias: 'WRITE_TEXT_STRING'];
+Procedure WriteBuffer(var f:TextRec;var b;len:longint);
 var
-  hbytes,Pos,copybytes : Longint;
-  hs : String;
-Begin
-  If f.mode<>fmOutput Then
-   exit;
-  copybytes:=Length(s);
-  If Len>copybytes Then
-   Begin
-     hs:=Space(Len-copybytes);
-     w(0,f,hs);
-   End;
-  Pos:=1;
-  hbytes:=f.BufSize-f.BufPos;
-  { If no room in Buffer, do a flush. }
-  If hbytes=0 Then
-   FileFunc(f.FlushFunc)(f);
-  while copybytes>hbytes Do
-   Begin
-     Move(s[Pos],f.Bufptr^[f.BufPos],hbytes);
-     f.BufPos:=f.BufPos+hbytes;
-     copybytes:=copybytes-hbytes;
-     pos:=pos+hbytes;
+  p   : pchar;
+  left,
+  idx : longint;
+begin
+  p:=pchar(@b);
+  idx:=0;
+  left:=f.BufSize-f.BufPos;
+  while len>left do
+   begin
+     move(p[idx],f.Bufptr^[f.BufPos],left);
+     dec(len,left);
+     inc(idx,left);
+     inc(f.BufPos,left);
      FileFunc(f.InOutFunc)(f);
-     hbytes:=f.BufSize-f.BufPos;
-   End;
-  Move(s[Pos],f.Bufptr^[f.BufPos],copybytes);
-  f.BufPos:=f.BufPos+copybytes;
-End;
+     left:=f.BufSize-f.BufPos;
+   end;
+  move(p[idx],f.Bufptr^[f.BufPos],len);
+  inc(f.BufPos,len);
+end;
 
 
-Procedure w(var t : TextRec);[Public,Alias: 'WRITELN_TEXT'];
+Procedure WriteBlanks(var f:TextRec;len:longint);
 var
-  hs : String;
-Begin
+  left : longint;
+begin
+  left:=f.BufSize-f.BufPos;
+  while len>left do
+   begin
+     FillChar(f.Bufptr^[f.BufPos],left,' ');
+     dec(len,left);
+     inc(f.BufPos,left);
+     FileFunc(f.InOutFunc)(f);
+     left:=f.BufSize-f.BufPos;
+   end;
+  FillChar(f.Bufptr^[f.BufPos],len,' ');
+  inc(f.BufPos,len);
+end;
+
+
+Procedure Write_End(var f:TextRec);[Public,Alias:'WRITE_END'];
+begin
+  if f.FlushFunc<>nil then
+   FileFunc(f.FlushFunc)(f);
+end;
+
+
+Procedure Writeln_End(var f:TextRec);[Public,Alias:'WRITELN_END'];
+const
 {$IFDEF SHORT_LINEBREAK}
-  hs:=#10;
-{$ELSE}
-  hs:=#13#10;
-{$ENDIF}
-  w(0,t,hs);
+  eollen=1;
+  eol : array[0..0] of char=(#10);
+{$ELSE SHORT_LINEBREAK}
+  eollen=2;
+  eol : array[0..1] of char=(#13,#10);
+{$ENDIF SHORT_LINEBREAK}
+begin
+{ Write EOL }
+  WriteBuffer(f,eol,eollen);
+{ Flush }
+  if f.FlushFunc<>nil then
+   FileFunc(f.FlushFunc)(f);
+end;
+
+
+Procedure Write_Str(Len : Longint;var f : TextRec;const s : String);[Public,Alias: 'WRITE_TEXT_STRING'];
+Begin
+  If f.mode<>fmOutput Then
+   exit;
+  If Len>Length(s) Then
+   WriteBlanks(f,Len-Length(s));
+  WriteBuffer(f,s[1],Length(s));
 End;
 
 
 Type
    array00 = array[0..0] Of Char;
-Procedure w(Len : Longint;var f : TextRec;const p : array00);[Public,Alias: 'WRITE_TEXT_PCHAR_AS_ARRAY'];
+Procedure Write_Array(Len : Longint;var f : TextRec;const p : array00);[Public,Alias: 'WRITE_TEXT_PCHAR_AS_ARRAY'];
 var
-  hbytes,Pos,copybytes : Longint;
-  hs : String;
+  ArrayLen : longint;
 Begin
   If f.mode<>fmOutput Then
    exit;
-  copybytes:=StrLen(p);
-  If Len>copybytes Then
-   Begin
-     hs:=Space(Len-copybytes);
-     w(0,f,hs);
-   End;
-  Pos:=0;
-  hbytes:=f.BufSize-f.BufPos;
-  { If no room in buffer , do a flush. }
-  If hbytes=0 Then
-    FileFunc(f.FlushFunc)(f);
-  while copybytes>hbytes Do
-   Begin
-     Move(p[Pos],f.Bufptr^[f.BufPos],hbytes);
-     f.BufPos:=f.BufPos+hbytes;
-     copybytes:=copybytes-hbytes;
-     pos:=pos+hbytes;
-     FileFunc(f.InOutFunc)(f);
-     hbytes:=f.BufSize-f.BufPos;
-   End;
-  Move(p[Pos],f.Bufptr^[f.BufPos],copybytes);
-  f.BufPos:=f.BufPos+copybytes;
+  ArrayLen:=StrLen(p);
+  If Len>ArrayLen Then
+   WriteBlanks(f,Len-ArrayLen);
+  WriteBuffer(f,p,ArrayLen);
 End;
 
 
-Procedure wa(Len : Longint;var f : TextRec;p : PChar);[Public,Alias: 'WRITE_TEXT_PCHAR_AS_POINTER'];
+Procedure Write_PChar(Len : Longint;var f : TextRec;p : PChar);[Public,Alias: 'WRITE_TEXT_PCHAR_AS_POINTER'];
+var
+  PCharLen : longint;
 Begin
-  w(Len,f,p);
+  If f.mode<>fmOutput Then
+   exit;
+  PCharLen:=StrLen(p);
+  If Len>PCharLen Then
+   WriteBlanks(f,Len-PCharLen);
+  WriteBuffer(f,p^,PCharLen);
 End;
 
 
-Procedure w(Len : Longint;var t : TextRec;l : Longint);[Public,Alias: 'WRITE_TEXT_LONGINT'];
+Procedure Write_LongInt(Len : Longint;var t : TextRec;l : Longint);[Public,Alias: 'WRITE_TEXT_LONGINT'];
 var
   s : String;
 Begin
   Str(l,s);
-  w(Len,t,s);
+  Write_Str(Len,t,s);
 End;
 
 
-Procedure w(fixkomma,Len : Longint;var t : TextRec;r : real);[Public,Alias: 'WRITE_TEXT_REAL'];
+Procedure Write_Real(fixkomma,Len : Longint;var t : TextRec;r : real);[Public,Alias: 'WRITE_TEXT_REAL'];
 var
    s : String;
 Begin
@@ -445,88 +472,97 @@ Begin
 {$else}
    Str_real(Len,fixkomma,r,rt_s32real,s);
 {$endif}
-   w(Len,t,s);
+   Write_Str(Len,t,s);
 End;
 
 
-Procedure w(Len : Longint;var t : TextRec;l : cardinal);[Public,Alias: 'WRITE_TEXT_CARDINAL'];
+Procedure Write_Cardinal(Len : Longint;var t : TextRec;l : cardinal);[Public,Alias: 'WRITE_TEXT_CARDINAL'];
 var
   s : String;
 Begin
   Str(L,s);
-  w(Len,t,s);
+  Write_Str(Len,t,s);
 End;
 
 
-Procedure w(fixkomma,Len : Longint;var t : TextRec;r : single);[Public,Alias: 'WRITE_TEXT_SINGLE'];
+Procedure Write_Single(fixkomma,Len : Longint;var t : TextRec;r : single);[Public,Alias: 'WRITE_TEXT_SINGLE'];
 var
   s : String;
 Begin
   Str_real(Len,fixkomma,r,rt_s32real,s);
-  w(Len,t,s);
+  Write_Str(Len,t,s);
 End;
 
 
 {$ifdef SUPPORT_EXTENDED}
-Procedure w(fixkomma,Len : Longint;var t : TextRec;r : extended);[Public,Alias: 'WRITE_TEXT_EXTENDED'];
+Procedure Write_Extended(fixkomma,Len : Longint;var t : TextRec;r : extended);[Public,Alias: 'WRITE_TEXT_EXTENDED'];
 var
   s : String;
 Begin
   Str_real(Len,fixkomma,r,rt_s80real,s);
-  w(Len,t,s);
+  Write_Str(Len,t,s);
 End;
 {$endif SUPPORT_EXTENDED}
 
 
 {$ifdef SUPPORT_COMP}
-Procedure w(fixkomma,Len : Longint;var t : TextRec;r : comp);[Public,Alias: 'WRITE_TEXT_COMP'];
+Procedure Write_Comp(fixkomma,Len : Longint;var t : TextRec;r : comp);[Public,Alias: 'WRITE_TEXT_COMP'];
 var
   s : String;
 Begin
   Str_real(Len,fixkomma,r,rt_s64bit,s);
-  w(Len,t,s);
+  Write_Str(Len,t,s);
 End;
 {$endif SUPPORT_COMP}
 
-Procedure w(fixkomma,Len : Longint;var t : TextRec;r : fixed);[Public,Alias: 'WRITE_TEXT_FIXED'];
+
+Procedure Write_Fixed(fixkomma,Len : Longint;var t : TextRec;r : fixed);[Public,Alias: 'WRITE_TEXT_FIXED'];
 var
   s : String;
 Begin
   Str_real(Len,fixkomma,r,rt_f32bit,s);
-  w(Len,t,s);
+  Write_Str(Len,t,s);
 End;
 
 
-{ Is called wc to avoid recursive calling. }
-Procedure wc(Len : Longint;var t : TextRec;b : Boolean);[Public,Alias: 'WRITE_TEXT_BOOLEAN'];
-const
-  BoolString:array[0..1] Of String[5]=('FALSE','TRUE');
+Procedure Write_Boolean(Len : Longint;var t : TextRec;b : Boolean);[Public,Alias: 'WRITE_TEXT_BOOLEAN'];
 Begin
-   if b then
-     w(Len,t,String(BoolString[1]))
-   else
-     w(Len,t,String(BoolString[0]));
+{ Can't use array[boolean] because b can be >0 ! }
+  if b then
+    Write_Str(Len,t,'TRUE')
+  else
+    Write_Str(Len,t,'FALSE');
 End;
 
 
-Procedure wc(Len : Longint;var t : TextRec;c : Char);[Public,Alias: 'WRITE_TEXT_CHAR'];
-var
-   hs : String;
+Procedure Write_Char(Len : Longint;var t : TextRec;c : Char);[Public,Alias: 'WRITE_TEXT_CHAR'];
 Begin
   If t.mode<>fmOutput Then
    exit;
   If Len>1 Then
-   Begin
-     hs:=Space(Len-1);
-     w(0,t,hs);
-   End;
+   WriteBlanks(t,Len-1);
   If t.BufPos+1>=t.BufSize Then
-   FileFunc(t.FlushFunc)(t);
+   FileFunc(t.InOutFunc)(t);
   t.Bufptr^[t.BufPos]:=c;
   Inc(t.BufPos);
 End;
 
 
+{$IFNDEF NEW_READWRITE}
+Procedure w(var t : TextRec);[Public,Alias: 'WRITELN_TEXT'];
+var
+  hs : String;
+Begin
+  {$IFDEF SHORT_LINEBREAK}
+   hs:=#10;
+  {$ELSE}
+   hs:=#13#10;
+  {$ENDIF}
+  Write_Str(0,t,hs);
+End;
+{$ENDIF NEW_READWRITE}
+
+
 {*****************************************************************************
                                 Read(Ln)
 *****************************************************************************}
@@ -624,10 +660,18 @@ begin
 end;
 
 
-Procedure r(var f : TextRec);[Public,Alias: 'READLN_TEXT'];
+Procedure Read_End(var f:TextRec);[Public,Alias:'READ_END'];
+begin
+  if f.FlushFunc<>nil then
+   FileFunc(f.FlushFunc)(f);
+end;
+
+
+Procedure ReadLn_End(var f : TextRec);[Public,Alias: 'READLN_END'];
 Begin
   if not OpenInput(f) then
    exit;
+{ Read until a linebreak }
   while (f.BufPos<f.BufEnd) do
    begin
      inc(f.BufPos);
@@ -636,10 +680,13 @@ Begin
      If f.BufPos>=f.BufEnd Then
       FileFunc(f.InOutFunc)(f);
    end;
+{ Flush if set }
+  if f.FlushFunc<>nil then
+   FileFunc(f.FlushFunc)(f);
 End;
 
 
-Procedure r(var f : TextRec;var s : String);[Public,Alias: 'READ_TEXT_STRING'];
+Procedure Read_String(var f : TextRec;var s : String);[Public,Alias: 'READ_TEXT_STRING'];
 var
   Temp,sPos : Word;
 Begin
@@ -659,6 +706,7 @@ Begin
       Begin
         Move (f.Bufptr^[f.BufPos],s[sPos],Temp-f.BufPos);
         sPos:=sPos+Temp-f.BufPos;
+      { Remove #13 from a #13#10 break }
         If s[sPos-1]=#13 Then
          dec(sPos);
       End
@@ -680,7 +728,7 @@ Begin
 End;
 
 
-Procedure r(var f : TextRec;var c : Char);[Public,Alias: 'READ_TEXT_CHAR'];
+Procedure Read_Char(var f : TextRec;var c : Char);[Public,Alias: 'READ_TEXT_CHAR'];
 Begin
   c:=#0;
   if not OpenInput(f) then
@@ -693,7 +741,7 @@ Begin
 End;
 
 
-Procedure r(var f : TextRec;var s : PChar);[Public,Alias:'READ_TEXT_PCHAR_AS_POINTER'];
+Procedure Read_PChar(var f : TextRec;var s : PChar);[Public,Alias:'READ_TEXT_PCHAR_AS_POINTER'];
 var
   p    : PChar;
   Temp : byte;
@@ -711,7 +759,7 @@ Begin
       inc(Temp);
      { copy string. }
      Move (f.Bufptr^[f.BufPos],p^,Temp-f.BufPos);
-     longint(p):=longint(p)+(temp-f.bufpos);
+     Inc(Longint(p),Temp-f.BufPos);
      If pchar(p-1)^=#13 Then
       dec(p);
      { update f.BufPos }
@@ -726,7 +774,7 @@ Begin
 End;
 
 
-Procedure r(var f : TextRec;var s : array00);[Public,Alias:'READ_TEXT_PCHAR_AS_ARRAY'];
+Procedure Read_Array(var f : TextRec;var s : array00);[Public,Alias:'READ_TEXT_PCHAR_AS_ARRAY'];
 var
   p    : PChar;
   Temp : byte;
@@ -744,7 +792,7 @@ Begin
       inc(Temp);
      { copy string. }
      Move (f.Bufptr^[f.BufPos],p^,Temp-f.BufPos);
-     longint(p):=longint(p)+(temp-f.bufpos);
+     Inc(Longint(p),Temp-f.BufPos);
      If pchar(p-1)^=#13 Then
       dec(p);
      { update f.BufPos }
@@ -759,7 +807,7 @@ Begin
 End;
 
 
-Procedure r(var f : TextRec;var l : Longint);[Public,Alias: 'READ_TEXT_LONGINT'];
+Procedure Read_Longint(var f : TextRec;var l : Longint);[Public,Alias: 'READ_TEXT_LONGINT'];
 var
   hs   : String;
   code : Word;
@@ -777,11 +825,11 @@ Begin
 End;
 
 
-Procedure r(var f : TextRec;var l : Integer);[Public,Alias: 'READ_TEXT_INTEGER'];
+Procedure Read_Integer(var f : TextRec;var l : Integer);[Public,Alias: 'READ_TEXT_INTEGER'];
 var
   ll : Longint;
 Begin
-  r(f,ll);
+  Read_Longint(f,ll);
   l:=0;
   If (ll<-32768) or (ll>32767) Then
    RunError(106);
@@ -789,11 +837,11 @@ Begin
 End;
 
 
-Procedure r(var f : TextRec;var l : Word);[Public,Alias: 'READ_TEXT_WORD'];
+Procedure Read_Word(var f : TextRec;var l : Word);[Public,Alias: 'READ_TEXT_WORD'];
 var
   ll : Longint;
 Begin
-  r(f,ll);
+  Read_Longint(f,ll);
   l:=0;
   If (ll<0) or (ll>$ffff) Then
    RunError(106);
@@ -801,11 +849,11 @@ Begin
 End;
 
 
-Procedure r(var f : TextRec;var l : byte);[Public,Alias: 'READ_TEXT_BYTE'];
+Procedure Read_Byte(var f : TextRec;var l : byte);[Public,Alias: 'READ_TEXT_BYTE'];
 var
   ll : Longint;
 Begin
-  r(f,ll);
+  Read_Longint(f,ll);
   l:=0;
   If (ll<0) or (ll>255) Then
    RunError(106);
@@ -813,11 +861,11 @@ Begin
 End;
 
 
-Procedure r(var f : TextRec;var l : shortint);[Public,Alias: 'READ_TEXT_SHORTINT'];
+Procedure Read_Shortint(var f : TextRec;var l : shortint);[Public,Alias: 'READ_TEXT_SHORTINT'];
 var
    ll : Longint;
 Begin
-  r(f,ll);
+  Read_Longint(f,ll);
   l:=0;
   If (ll<-128) or (ll>127) Then
    RunError(106);
@@ -825,7 +873,7 @@ Begin
 End;
 
 
-Procedure r(var f : TextRec;var l : cardinal);[Public,Alias: 'READ_TEXT_CARDINAL'];
+Procedure Read_Cardinal(var f : TextRec;var l : cardinal);[Public,Alias: 'READ_TEXT_CARDINAL'];
 var
   hs   : String;
   code : Word;
@@ -843,7 +891,7 @@ Begin
 End;
 
 
-Procedure r(var f : TextRec;var d : Real);[Public,Alias: 'READ_TEXT_REAL'];
+Procedure Read_Real(var f : TextRec;var d : Real);[Public,Alias: 'READ_TEXT_REAL'];
 var
   hs   : String;
   code : Word;
@@ -881,7 +929,7 @@ End;
 
 
 {$ifdef SUPPORT_EXTENDED}
-Procedure r(var f : TextRec;var d : extended);[Public,Alias: 'READ_TEXT_EXTENDED'];
+Procedure Read_Extended(var f : TextRec;var d : extended);[Public,Alias: 'READ_TEXT_EXTENDED'];
 var
   hs   : String;
   code : Word;
@@ -920,7 +968,7 @@ End;
 
 
 {$ifdef SUPPORT_COMP}
-Procedure r(var f : TextRec;var d : comp);[Public,Alias: 'READ_TEXT_COMP'];
+Procedure Read_Comp(var f : TextRec;var d : comp);[Public,Alias: 'READ_TEXT_COMP'];
 var
   hs   : String;
   code : Word;
@@ -957,9 +1005,52 @@ Begin
 End;
 {$endif SUPPORT_COMP}
 
+
+{$IFNDEF NEW_READWRITE}
+Procedure r(var f : TextRec);[Public,Alias: 'READLN_TEXT'];
+Begin
+  if not OpenInput(f) then
+   exit;
+  while (f.BufPos<f.BufEnd) do
+   begin
+     inc(f.BufPos);
+     if (f.BufPtr^[f.BufPos-1]=#10) then
+      exit;
+     If f.BufPos>=f.BufEnd Then
+      FileFunc(f.InOutFunc)(f);
+   end;
+End;
+{$ENDIF NEW_READWRITE}
+
+
+{*****************************************************************************
+                               Initializing
+*****************************************************************************}
+
+procedure OpenStdIO(var f:text;mode:word;hdl:longint);
+begin
+  Assign(f,'');
+  TextRec(f).Handle:=hdl;
+  TextRec(f).Mode:=mode;
+  TextRec(f).Closefunc:=@FileCloseFunc;
+  case mode of
+  fmInput : TextRec(f).InOutFunc:=@FileReadFunc;
+ fmOutput : begin
+              TextRec(f).InOutFunc:=@FileWriteFunc;
+              TextRec(f).FlushFunc:=@FileWriteFunc;
+            end;
+  else
+   RunError(102);
+  end;
+end;
+
+
 {
   $Log$
-  Revision 1.12  1998-07-01 14:48:10  carl
+  Revision 1.13  1998-07-01 15:30:00  peter
+    * better readln/writeln
+
+  Revision 1.12  1998/07/01 14:48:10  carl
     * bugfix of WRITE_TEXT_BOOLEAN , was not TP compatible
     + added explicit typecast in OpenText
 

rtl/linux/syslinux.pp

@@ -461,11 +461,32 @@ Begin
    begin
      Oflags:=Oflags and not(Open_RDWR);
      FileRec(f).Handle:=sys_open(p,oflags,438);
-   end;     
+   end;
+
   Errno2Inoutres;
 {$endif}
 End;
 
+
+Function Do_IsDevice(Handle:Longint):boolean;
+{
+  Interface to Unix ioctl call.
+  Performs various operations on the filedescriptor Handle.
+  Ndx describes the operation to perform.
+  Data points to data needed for the Ndx function. The structure of this
+  data is function-dependent.
+}
+var
+  sr: SysCallRegs;
+  Data : array[0..255] of byte; {Large enough for termios info}
+begin
+  sr.reg2:=Handle;
+  sr.reg3:=$5401; {=TCGETS}
+  sr.reg4:=Longint(@Data);
+  Do_IsDevice:=(SysCall(Syscall_nr_ioctl,sr)=0);
+end;
+
+
 {*****************************************************************************
                            UnTyped File Handling
 *****************************************************************************}
@@ -639,34 +660,23 @@ begin
 end;
 
 
-procedure OpenStdIO(var f:text;mode:word;const std:string;hdl:longint);
-begin
-  Assign(f,std);
-  TextRec(f).Handle:=hdl;
-  TextRec(f).Mode:=mode;
-  TextRec(f).InOutFunc:=@FileInOutFunc;
-  TextRec(f).FlushFunc:=@FileInOutFunc;
-  TextRec(f).Closefunc:=@fileclosefunc;
-end;
-
-
 Begin
 { Set up segfault Handler }
   InstallSegFaultHandler;
 { Setup heap }
   InitHeap;
 { Setup stdin, stdout and stderr }
-  OpenStdIO(Input,fmInput,'stdin',StdInputHandle);
-  OpenStdIO(Output,fmOutput,'stdout',StdOutputHandle);
-  OpenStdIO(StdErr,fmOutput,'stderr',StdErrorHandle);
+  OpenStdIO(Input,fmInput,StdInputHandle);
+  OpenStdIO(Output,fmOutput,StdOutputHandle);
+  OpenStdIO(StdErr,fmOutput,StdErrorHandle);
 { Reset IO Error }
   InOutRes:=0;
 End.
 
 {
   $Log$
-  Revision 1.5  1998-06-23 16:57:17  peter
-    * fixed the filesize() problems under linux and filerec.size=0 error
+  Revision 1.6  1998-07-01 15:30:01  peter
+    * better readln/writeln
 
   Revision 1.4  1998/05/30 14:18:43  peter
     * fixed to remake with -Rintel in the ppc386.cfg

rtl/win32/syswin32.pp

@@ -18,6 +18,7 @@
 unit syswin32;
 
 {$I os.inc}
+{$DEFINE WINHEAP}
 
 interface
 
@@ -25,6 +26,11 @@ interface
 
 {$I systemh.inc}
 
+{$ifndef WinHeap}
+  { include heap support headers }
+  {$I heaph.inc}
+{$endif}
+
 const
 { Default filehandles }
    UnusedHandle    : longint = -1;
@@ -55,16 +61,25 @@ type
   end;
 
 var
+{ C compatible arguments }
+  argc  : longint;
+  argv  : ppchar;
+{ Win32 Info }
   startupinfo : tstartupinfo;
   hprevinst,
   hinstance,
   cmdshow     : longint;
-  heaperror   : pointer;
+
+{$ifdef WinHeap}
+var
+  heaperror  : pointer;
+
+function HeapSize:longint;
+{$endif}
 
 implementation
 
 { include system independent routines }
-
 {$I system.inc}
 
 { some declarations for Win32 API calls }
@@ -79,12 +94,10 @@ type
    function MessageBox(w1:longint;l1,l2:pointer;w2:longint):longint;
      external 'user32' name 'MessageBoxA';
 
-   { command line/enviroment functions }
-   function GetCommandLine : LPTSTR;
-     external 'kernel32' name 'GetCommandLineA';
    { time and date functions }
    function GetTickCount : longint;
      external 'kernel32' name 'GetTickCount';
+
    { process functions }
    procedure ExitProcess(uExitCode : UINT);
      external 'kernel32' name 'ExitProcess';
@@ -131,92 +144,22 @@ end;
 procedure halt(errnum : byte);
 begin
   do_exit;
-  flush(stderr);
   ExitProcess(errnum);
 end;
 
 
 function paramcount : longint;
-var
-  count   : longint;
-  cmdline : pchar;
-  quote   : set of char;
 begin
-  cmdline:=GetCommandLine;
-  count:=0;
-  while true do
-   begin
-     { skip leading spaces }
-     while cmdline^ in [' ',#9] do
-       cmdline:=cmdline+1;
-     if cmdline^='"' then
-       begin
-          quote:=['"'];
-          cmdline:=cmdline+1;
-       end
-     else
-       quote:=[' ',#9];
-     if cmdline^=#0 then
-       break;
-     inc(count);
-     while (cmdline^<>#0) and not(cmdline^ in quote) do
-       cmdline:=cmdline+1;
-     { skip quote }
-     if cmdline^ in quote then
-       cmdline:=cmdline+1;
-   end;
-  paramcount:=count-1;
+  paramcount := argc - 1;
 end;
 
 
 function paramstr(l : longint) : string;
-var
-  s       : string;
-  count   : longint;
-  cmdline : pchar;
-  quote   : set of char;
 begin
-  s:='';
-  if (l>=0) and (l<=paramcount) then
-    begin
-       cmdline:=GetCommandLine;
-       count:=0;
-       while true do
-         begin
-            { skip leading spaces }
-            while cmdline^ in [' ',#9] do
-              cmdline:=cmdline+1;
-            if cmdline^='"' then
-              begin
-                 quote:=['"'];
-                 cmdline:=cmdline+1;
-              end
-            else
-              quote:=[' ',#9];
-            if cmdline^=#0 then
-              break;
-            if count=l then
-              begin
-                 while (cmdline^<>#0) and not(cmdline^ in quote) do
-                   begin
-                      s:=s+cmdline^;
-                      cmdline:=cmdline+1;
-                   end;
-                 break;
-              end
-            else
-              begin
-                 while (cmdline^<>#0) and not(cmdline^ in quote) do
-                   cmdline:=cmdline+1;
-              end;
-            { skip quote }
-            if cmdline^ in quote then
-              cmdline:=cmdline+1;
-            inc(count);
-         end;
-
-    end;
-  paramstr:=s;
+  if (l>=0) and (l+1<=argc) then
+   paramstr:=strpas(argv[l])
+  else
+   paramstr:='';
 end;
 
 
@@ -230,8 +173,50 @@ end;
                               Heap Management
 *****************************************************************************}
 
-{ Include Windows Heap manager }
-{$I winheap.inc}
+{$ifdef WinHeap}
+
+  {$i winheap.inc}
+
+{$else}
+
+   { memory functions }
+   function GlobalAlloc(mode,size:longint):longint;
+     external 'kernel32' name 'GlobalAlloc';
+   function GlobalReAlloc(mode,size:longint):longint;
+     external 'kernel32' name 'GlobalReAlloc';
+   function GlobalHandle(p:pointer):longint;
+     external 'kernel32' name 'GlobalHandle';
+   function GlobalLock(handle:longint):pointer;
+     external 'kernel32' name 'GlobalLock';
+   function GlobalUnlock(h:longint):longint;
+     external 'kernel32' name 'GlobalUnlock';
+   function GlobalFree(h:longint):longint;
+     external 'kernel32' name 'GlobalFree';
+   function GlobalSize(h:longint):longint;
+     external 'kernel32' name 'GlobalSize';
+   procedure GlobalMemoryStatus(p:pointer);
+     external 'kernel32' name 'GlobalMemoryStatus';
+   function LocalAlloc(uFlags : UINT;uBytes :UINT) : HLOCAL;
+     external 'kernel32' name 'LocalAlloc';
+   function LocalFree(hMem:HLOCAL):HLOCAL;
+     external 'kernel32' name 'LocalFree';
+
+function Sbrk(size : longint):longint;
+var
+  h,l : longint;
+begin
+  h:=GlobalAlloc(258,size);
+  GlobalLock(h);
+  l:=GlobalSize(h);
+  writeln(l);
+  sbrk:=l;
+end;
+
+{ include standard heap management }
+{$I heap.inc}
+
+{$endif WinHeap}
+
 
 {*****************************************************************************
                           Low Level File Routines
@@ -258,6 +243,8 @@ end;
      external 'kernel32' name 'CreateFileA';
    function SetEndOfFile(h : longint) : boolean;
      external 'kernel32' name 'SetEndOfFile';
+   function GetFileType(Handle:DWORD):DWord;
+     external 'kernel32' name 'GetFileType';
 
 
 procedure AllowSlash(p:pchar);
@@ -442,6 +429,14 @@ begin
    inoutres:=GetLastError;
 end;
 
+
+function do_isdevice(handle:longint):boolean;
+begin
+  do_isdevice:=(getfiletype(handle)=2);
+end;
+
+
+
 {*****************************************************************************
                            UnTyped File Handling
 *****************************************************************************}
@@ -539,15 +534,80 @@ procedure getdir(drivenr:byte;var dir:string);
    function GetStdHandle(nStdHandle:DWORD):THANDLE;
      external 'kernel32' name 'GetStdHandle';
 
+   { command line/enviroment functions }
+   function GetCommandLine : pchar;
+     external 'kernel32' name 'GetCommandLineA';
+
    { module functions }
    function GetModuleFileName(l1:longint;p:pointer;l2:longint):longint;
      external 'kernel32' name 'GetModuleFileNameA';
    function GetModuleHandle(p : pointer) : longint;
      external 'kernel32' name 'GetModuleHandleA';
 
+var
+  ModuleName : array[0..255] of char;
+function GetCommandFile:pchar;
+begin
+  GetModuleFileName(0,@ModuleName,255);
+  GetCommandFile:=@ModuleName;
+end;
+
+
+procedure setup_arguments;
+var
+  arglen,
+  count   : longint;
+  argstart,
+  cmdline : pchar;
+  quote   : set of char;
+  argsbuf : array[0..127] of pchar;
+begin
+{ create commandline, it starts with the executed filename which is argv[0] }
+  cmdline:=GetCommandLine;
+  count:=0;
+  repeat
+  { skip leading spaces }
+    while cmdline^ in [' ',#9,#13] do
+     inc(longint(cmdline));
+    case cmdline^ of
+      #0 : break;
+     '"' : begin
+             quote:=['"'];
+             inc(longint(cmdline));
+           end;
+    '''' : begin
+             quote:=[''''];
+             inc(longint(cmdline));
+           end;
+    else
+     quote:=[' ',#9,#13];
+    end;
+  { scan until the end of the argument }
+    argstart:=cmdline;
+    while (cmdline^<>#0) and not(cmdline^ in quote) do
+     inc(longint(cmdline));
+  { reserve some memory }
+    arglen:=cmdline-argstart;
+    getmem(argsbuf[count],arglen+1);
+    move(argstart^,argsbuf[count]^,arglen);
+    argsbuf[count][arglen]:=#0;
+  { skip quote }
+    if cmdline^ in quote then
+     inc(longint(cmdline));
+    inc(count);
+  until false;
+{ create argc }
+  argc:=count;
+{ create an nil entry }
+  argsbuf[count]:=nil;
+  inc(count);
+{ create the argv }
+  getmem(argv,count shl 2);
+  move(argsbuf,argv^,count shl 2);
+end;
 
-{$ASMMODE DIRECT}
 
+{$ASMMODE DIRECT}
 procedure Entry;[public,alias: '_mainCRTStartup'];
 begin
    { call to the pascal main }
@@ -557,32 +617,22 @@ begin
    { that's all folks }
    ExitProcess(0);
 end;
-
 {$ASMMODE ATT}
 
 
-procedure OpenStdIO(var f:text;mode:word;hdl:longint);
-begin
-  Assign(f,'');
-  TextRec(f).Handle:=hdl;
-  TextRec(f).Mode:=mode;
-  TextRec(f).InOutFunc:=@FileInOutFunc;
-  TextRec(f).FlushFunc:=@FileInOutFunc;
-  TextRec(f).Closefunc:=@fileclosefunc;
-end;
-
-
-var
-  s : string;
 begin
 { get some helpful informations }
   GetStartupInfo(@startupinfo);
-{ Initialize ExitProc }
-  ExitProc:=Nil;
+{ some misc Win32 stuff }
+  hprevinst:=0;
+  hinstance:=getmodulehandle(GetCommandFile);
+  cmdshow:=startupinfo.wshowwindow;
 { to test stack depth }
   loweststack:=maxlongint;
 { Setup heap }
-{!!!  InitHeap; }
+{$ifndef WinHeap}
+  InitHeap;
+{$endif WinHeap}
 { Setup stdin, stdout and stderr }
   StdInputHandle:=longint(GetStdHandle(STD_INPUT_HANDLE));
   StdOutputHandle:=longint(GetStdHandle(STD_OUTPUT_HANDLE));
@@ -590,18 +640,18 @@ begin
   OpenStdIO(Input,fmInput,StdInputHandle);
   OpenStdIO(Output,fmOutput,StdOutputHandle);
   OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+{ Arguments }
+  setup_arguments;
 { Reset IO Error }
   InOutRes:=0;
-{ some misc Win32 stuff }
-  hprevinst:=0;
-  getmodulefilename(0,@s,256);
-  hinstance:=getmodulehandle(@s);
-  cmdshow:=startupinfo.wshowwindow;
 end.
 
 {
   $Log$
-  Revision 1.9  1998-06-10 10:39:17  peter
+  Revision 1.10  1998-07-01 15:30:02  peter
+    * better readln/writeln
+
+  Revision 1.9  1998/06/10 10:39:17  peter
     * working w32 rtl
 
   Revision 1.8  1998/06/08 23:07:47  peter

rtl/win32/winheap.inc

@@ -24,13 +24,9 @@
    function GlobalUnlock(h:longint):longint;
      external 'kernel32' name 'GlobalUnlock';
    function GlobalFree(h:longint):longint;
-     external 'kernel32' name 'GlobalUnlock';
+     external 'kernel32' name 'GlobalFree';
    procedure GlobalMemoryStatus(p:pointer);
      external 'kernel32' name 'GlobalMemoryStatus';
-   function LocalAlloc(uFlags : UINT;uBytes :UINT) : HLOCAL;
-     external 'kernel32' name 'LocalAlloc';
-   function LocalFree(hMem:HLOCAL):HLOCAL;
-     external 'kernel32' name 'LocalFree';
 
 
 type
@@ -56,7 +52,7 @@ end;
 
 procedure getmem(var p:pointer;size:longint);[public,alias: 'GETMEM'];
 begin
-  p:=GlobalLock(GlobalAlloc(258,size));
+  p:=GlobalLock(GlobalAlloc($102,size));
   if p=nil then
    memerror(size)
 end;
@@ -67,13 +63,11 @@ var
   h:longint;
 begin
   h:=GlobalHandle(p);
-  if h<>0 then
-   if globalunlock(h)=0 then
-    if GlobalFree(h)=0 then
-     begin
-      p:=nil;
-      exit{allways if success!!!}
-     end;
+  if (h<>0) and (globalunlock(h)=0) and (GlobalFree(h)=0) then
+   begin
+     p:=nil;
+     exit;
+   end;
   p:=nil;
   memerror(size);
 end;
@@ -112,6 +106,12 @@ begin
 end;
 
 
+function HeapSize:longint;
+begin
+  HeapSize:=memmax(true);
+end;
+
+
 function growheap(size:longint):integer;
 begin
   growheap:=0;
@@ -119,7 +119,10 @@ end;
 
 {
   $Log$
-  Revision 1.3  1998-06-10 10:39:19  peter
+  Revision 1.4  1998-07-01 15:30:03  peter
+    * better readln/writeln
+
+  Revision 1.3  1998/06/10 10:39:19  peter
     * working w32 rtl
 
 }