* new lfn check from mailinglist

  * renamed win95 -> LFNSupport
  + tb_selector, tb_offset for easier access to transferbuffer

rtl/dos/dos.pp

@@ -611,11 +611,11 @@ begin
     if path[i]='/' then path[i]:='\';
   dosregs.si:=1; { use ms-dos time }
   dosregs.ecx:=attr;
-  dosregs.edx:=(transfer_buffer and 15) + Sizeof(LFNSearchrec)+1;
-  dosmemput(transfer_buffer shr 4,(transfer_buffer and 15)+Sizeof(LFNSearchrec)+1,path^,strlen(path)+1);
-  dosregs.ds:=transfer_buffer shr 4;
-  dosregs.edi:=transfer_buffer and 15;
-  dosregs.es:=transfer_buffer shr 4;
+  dosregs.edx:=tb_offset+Sizeof(LFNSearchrec)+1;
+  dosmemput(tb_selector,tb_offset+Sizeof(LFNSearchrec)+1,path^,strlen(path)+1);
+  dosregs.ds:=tb_selector;
+  dosregs.edi:=tb_offset;
+  dosregs.es:=tb_selector;
   dosregs.ax:=$714e;
   msdos(dosregs);
   LoadDosError;
@@ -631,8 +631,8 @@ var
 begin
   Move(s.Fill,hdl,4);
   dosregs.si:=1; { use ms-dos time }
-  dosregs.edi:=transfer_buffer and 15;
-  dosregs.es:=transfer_buffer shr 4;
+  dosregs.edi:=tb_offset;
+  dosregs.es:=tb_selector;
   dosregs.ebx:=hdl;
   dosregs.ax:=$714f;
   msdos(dosregs);
@@ -680,14 +680,14 @@ begin
   for i:=0 to strlen(path) do
     if path[i]='/' then path[i]:='\';
   copytodos(f,sizeof(searchrec));
-  dosregs.edx:=transfer_buffer and 15;
-  dosregs.ds:=transfer_buffer shr 4;
+  dosregs.edx:=tb_offset;
+  dosregs.ds:=tb_selector;
   dosregs.ah:=$1a;
   msdos(dosregs);
   dosregs.ecx:=attr;
-  dosregs.edx:=(transfer_buffer mod 16) + Sizeof(searchrec)+1;
-  dosmemput(transfer_buffer div 16,(transfer_buffer mod 16) +Sizeof(searchrec)+1,path^,strlen(path)+1);
-  dosregs.ds:=transfer_buffer div 16;
+  dosregs.edx:=tb_offset+Sizeof(searchrec)+1;
+  dosmemput(tb_selector,tb_offset+Sizeof(searchrec)+1,path^,strlen(path)+1);
+  dosregs.ds:=tb_selector;
   dosregs.ah:=$4e;
   msdos(dosregs);
   copyfromdos(f,sizeof(searchrec));
@@ -699,8 +699,8 @@ end;
 procedure Dosfindnext(var f : searchrec);
 begin
   copytodos(f,sizeof(searchrec));
-  dosregs.edx:=transfer_buffer mod 16;
-  dosregs.ds:=transfer_buffer div 16;
+  dosregs.edx:=tb_offset;
+  dosregs.ds:=tb_selector;
   dosregs.ah:=$1a;
   msdos(dosregs);
   dosregs.ah:=$4f;
@@ -764,7 +764,7 @@ begin
   doserror:=0;
   strpcopy(path0,path);
 {$ifdef Go32V2}
-  if Win95 then
+  if LFNSupport then
    LFNFindFirst(path0,attr,f)
   else
    Dosfindfirst(path0,attr,f);
@@ -778,7 +778,7 @@ procedure findnext(var f : searchRec);
 begin
   doserror:=0;
 {$ifdef Go32V2}
-  if Win95 then
+  if LFNSupport then
    LFNFindnext(f)
   else
    Dosfindnext(f);
@@ -791,7 +791,7 @@ end;
 Procedure FindClose(Var f: SearchRec);
 begin
 {$ifdef Go32V2}
-  if Win95 then
+  if LFNSupport then
    LFNFindClose(f);
 {$endif}
 end;
@@ -877,7 +877,7 @@ end;
           for i:=1 to length(pa) do
            if pa[i]='/' then
             pa[i]:='\';
- 
+
           if (length(pa)>1) and (pa[1] in ['A'..'Z']) and (pa[2]=':') then
             begin
                { we must get the right directory }
@@ -895,14 +895,14 @@ end;
               pa:=s+pa
             else
               pa:=s+'\'+pa;
- 
+
         { Turbo Pascal gives current dir on drive if only drive given as parameter! }
         if length(pa) = 2 then
          begin
            getdir(byte(pa[1])-64,s);
            pa := s;
          end;
- 
+
         {First remove all references to '\.\'}
           while pos ('\.\',pa)<>0 do
            delete (pa,pos('\.\',pa),2);
@@ -918,9 +918,9 @@ end;
                delete (pa,j,i-j+3);
              end;
           until i=0;
- 
+
           { Turbo Pascal gets rid of a \.. at the end of the path }
-          { Now remove also any reference to '\..'  at end of line 
+          { Now remove also any reference to '\..'  at end of line
             + of course previous dir.. }
           i:=pos('\..',pa);
           if i<>0 then
@@ -937,7 +937,7 @@ end;
           { Remove End . and \}
           if (length(pa)>0) and (pa[length(pa)]='.') then
            dec(byte(pa[0]));
-          { if only the drive + a '\' is left then the '\' should be left to prevtn the program 
+          { if only the drive + a '\' is left then the '\' should be left to prevtn the program
             accessing the current directory on the drive rather than the root!}
           { if the last char of path = '\' then leave it in as this is what TP does! }
           if ((length(pa)>3) and (pa[length(pa)]='\')) and (path[length(path)] <> '\') then
@@ -1021,13 +1021,13 @@ var
 begin
 {$ifdef GO32V2}
   copytodos(filerec(f).name,strlen(filerec(f).name)+1);
-  dosregs.edx:=transfer_buffer and 15;
-  dosregs.ds:=transfer_buffer shr 4;
+  dosregs.edx:=tb_offset;
+  dosregs.ds:=tb_selector;
 {$else}
   strpcopy(n,filerec(f).name);
   dosregs.edx:=longint(@n);
 {$endif}
-  if Win95 then
+  if LFNSupport then
    begin
      dosregs.ax:=$7143;
      dosregs.bx:=0;
@@ -1048,13 +1048,13 @@ var
 begin
 {$ifdef GO32V2}
   copytodos(filerec(f).name,strlen(filerec(f).name)+1);
-  dosregs.edx:=transfer_buffer mod 16;
-  dosregs.ds:=transfer_buffer div 16;
+  dosregs.edx:=tb_offset;
+  dosregs.ds:=tb_selector;
 {$else}
   strpcopy(n,filerec(f).name);
   dosregs.edx:=longint(@n);
 {$endif}
-  if Win95 then
+  if LFNSupport then
    begin
      dosregs.ax:=$7143;
      dosregs.bx:=1;
@@ -1139,7 +1139,12 @@ End;
 end.
 {
   $Log$
-  Revision 1.8  1998-08-16 20:39:49  peter
+  Revision 1.9  1998-08-26 10:04:01  peter
+    * new lfn check from mailinglist
+    * renamed win95 -> LFNSupport
+    + tb_selector, tb_offset for easier access to transferbuffer
+
+  Revision 1.8  1998/08/16 20:39:49  peter
     + LFN Support
 
   Revision 1.7  1998/08/16 09:12:13  michael

rtl/dos/go32.pp

@@ -159,6 +159,8 @@ unit go32;
     function get_run_mode : word;
 
     function transfer_buffer : longint;
+    function tb_selector : longint;
+    function tb_offset : longint;
     function tb_size : longint;
     procedure copytodos(var addr; len : longint);
     procedure copyfromdos(var addr; len : longint);
@@ -560,34 +562,24 @@ end ['EAX','EDX'];
 {$endif VER0_99_5}
 
 
-    function get_cs : word;
-
-      begin
-         asm
+    function get_cs : word;assembler;
+      asm
             movw %cs,%ax
-            movw %ax,__RESULT;
-         end;
       end;
 
 
-    function get_ss : word;
-
-      begin
-         asm
+    function get_ss : word;assembler;
+      asm
             movw %ss,%ax
-            movw %ax,__RESULT;
-         end;
       end;
 
-    function get_ds : word;
 
-      begin
-         asm
+    function get_ds : word;assembler;
+      asm
             movw %ds,%ax
-            movw %ax,__RESULT;
-         end;
       end;
 
+
     procedure test_int31(flag : longint);[alias : 'test_int31'];
       begin
          asm
@@ -1160,24 +1152,39 @@ end ['EAX','EDX'];
          end;
       end;
 
-{$ifndef V0_6}
 
-    function transfer_buffer : longint;
+{*****************************************************************************
+                              Transfer Buffer
+*****************************************************************************}
 
+    function transfer_buffer : longint;
       begin
          transfer_buffer := go32_info_block.linear_address_of_transfer_buffer;
       end;
 
-    function tb_size : longint;
 
+    function tb_selector : longint;
+      begin
+        tb_selector:=go32_info_block.linear_address_of_transfer_buffer shr 4;
+      end;
+
+
+    function tb_offset : longint;
+      begin
+        tb_offset:=go32_info_block.linear_address_of_transfer_buffer and $f;
+      end;
+
+
+    function tb_size : longint;
       begin
          tb_size := go32_info_block.size_of_transfer_buffer;
       end;
 
-     procedure copytodos(var addr; len : longint);
 
+    procedure copytodos(var addr; len : longint);
        begin
-          if len>tb_size then runerror(217);
+          if len>tb_size then
+            runerror(217);
 {$ifdef GO32V2}
           seg_move(get_ds,longint(@addr),dosmemselector,transfer_buffer,len);
 {$else GO32V2}
@@ -1185,10 +1192,11 @@ end ['EAX','EDX'];
 {$endif GO32V2}
        end;
 
-     procedure copyfromdos(var addr; len : longint);
 
+    procedure copyfromdos(var addr; len : longint);
        begin
-          if len > tb_size then runerror(217);
+          if len>tb_size then
+            runerror(217);
 {$ifdef GO32V2}
           seg_move(dosmemselector,transfer_buffer,get_ds,longint(@addr),len);
 {$else GO32V2}
@@ -1196,7 +1204,7 @@ end ['EAX','EDX'];
 {$endif GO32V2}
        end;
 
-{$endif not V0_6}
+
 
 begin
    int31error:=0;
@@ -1218,7 +1226,12 @@ end.
 
 {
   $Log$
-  Revision 1.10  1998-08-11 00:07:17  peter
+  Revision 1.11  1998-08-26 10:04:02  peter
+    * new lfn check from mailinglist
+    * renamed win95 -> LFNSupport
+    + tb_selector, tb_offset for easier access to transferbuffer
+
+  Revision 1.10  1998/08/11 00:07:17  peter
     * $ifdef ver0_99_5 instead of has_property
 
   Revision 1.9  1998/07/21 12:06:03  carl

rtl/dos/go32v2/system.pp

@@ -53,7 +53,7 @@ var
 
 {$ifndef RTLLITE}
 { System info }
-  Win95 : boolean;
+  LFNSupport : boolean;
 {$endif RTLLITE}
 
 type
@@ -213,6 +213,18 @@ begin
 end;
 
 
+function tb_selector : longint;
+begin
+  tb_selector:=go32_info_block.linear_address_of_transfer_buffer shr 4;
+end;
+
+
+function tb_offset : longint;
+begin
+  tb_offset:=go32_info_block.linear_address_of_transfer_buffer and $f;
+end;
+
+
 function tb_size : longint;
 begin
   tb_size:=go32_info_block.size_of_transfer_buffer;
@@ -588,7 +600,7 @@ end;
    var
       opennames : array [0..max_files-1] of pchar;
       openfiles : array [0..max_files-1] of boolean;
-      
+
 {$endif SYSTEMDEBUG}
 
 procedure do_close(handle : longint);
@@ -611,10 +623,10 @@ var
 begin
   AllowSlash(p);
   syscopytodos(longint(p),strlen(p)+1);
-  regs.realedx:=tb and 15;
-  regs.realds:=tb shr 4;
+  regs.realedx:=tb_offset;
+  regs.realds:=tb_selector;
 {$ifndef RTLLITE}
-  if Win95 then
+  if LFNSupport then
    regs.realeax:=$7141
   else
 {$endif RTLLITE}
@@ -637,12 +649,12 @@ begin
    HandleError(217);
   sysseg_move(get_ds,longint(p2),dos_selector,tb,strlen(p2)+1);
   sysseg_move(get_ds,longint(p1),dos_selector,tb+strlen(p2)+2,strlen(p1)+1);
-  regs.realedi:=tb and 15;
-  regs.realedx:=tb and 15 + strlen(p2)+2;
-  regs.realds:=tb shr 4;
-  regs.reales:=regs.realds;
+  regs.realedi:=tb_offset;
+  regs.realedx:=tb_offset + strlen(p2)+2;
+  regs.realds:=tb_selector;
+  regs.reales:=tb_selector;
 {$ifndef RTLLITE}
-  if Win95 then
+  if LFNSupport then
    regs.realeax:=$7156
   else
 {$endif RTLLITE}
@@ -669,8 +681,8 @@ begin
       size:=len;
      syscopytodos(addr+writesize,size);
      regs.realecx:=size;
-     regs.realedx:=tb and 15;
-     regs.realds:=tb shr 4;
+     regs.realedx:=tb_offset;
+     regs.realds:=tb_selector;
      regs.realebx:=h;
      regs.realeax:=$4000;
      sysrealintr($21,regs);
@@ -700,8 +712,8 @@ begin
      else
       size:=len;
      regs.realecx:=size;
-     regs.realedx:=tb and 15;
-     regs.realds:=tb shr 4;
+     regs.realedx:=tb_offset;
+     regs.realds:=tb_selector;
      regs.realebx:=h;
      regs.realeax:=$3f00;
      sysrealintr($21,regs);
@@ -796,8 +808,8 @@ var
 begin
   do_seek(handle,pos);
   regs.realecx:=0;
-  regs.realedx:=tb and 15;
-  regs.realds:=tb shr 4;
+  regs.realedx:=tb_offset;
+  regs.realds:=tb_selector;
   regs.realebx:=handle;
   regs.realeax:=$4000;
   sysrealintr($21,regs);
@@ -862,14 +874,14 @@ begin
 { real dos call }
   syscopytodos(longint(p),strlen(p)+1);
 {$ifndef RTLLITE}
-  if Win95 then
+  if LFNSupport then
    regs.realeax:=$716c
   else
 {$endif RTLLITE}
    regs.realeax:=$6c00;
   regs.realedx:=action;
-  regs.realds:=tb shr 4;
-  regs.realesi:=tb and 15;
+  regs.realds:=tb_selector;
+  regs.realesi:=tb_offset;
   regs.realebx:=$2000+(flags and $ff);
   regs.realecx:=$20;
   sysrealintr($21,regs);
@@ -943,10 +955,10 @@ begin
   buffer[length(s)]:=#0;
   AllowSlash(pchar(@buffer));
   syscopytodos(longint(@buffer),length(s)+1);
-  regs.realedx:=tb and 15;
-  regs.realds:=tb shr 4;
+  regs.realedx:=tb_offset;
+  regs.realds:=tb_selector;
 {$ifndef RTLLITE}
-  if Win95 then
+  if LFNSupport then
    regs.realeax:=$7100+func
   else
 {$endif RTLLITE}
@@ -959,21 +971,24 @@ end;
 
 procedure mkdir(const s : string);[IOCheck];
 begin
-  If InOutRes <> 0 then exit;
+  If InOutRes <> 0 then
+   exit;
   DosDir($39,s);
 end;
 
 
 procedure rmdir(const s : string);[IOCheck];
 begin
-  If InOutRes <> 0 then exit;
+  If InOutRes <> 0 then
+   exit;
   DosDir($3a,s);
 end;
 
 
 procedure chdir(const s : string);[IOCheck];
 begin
-  If InOutRes <> 0 then exit;
+  If InOutRes <> 0 then
+   exit;
   DosDir($3b,s);
 end;
 
@@ -985,10 +1000,10 @@ var
   regs : trealregs;
 begin
   regs.realedx:=drivenr;
-  regs.realesi:=tb and 15;
-  regs.realds:=tb shr 4;
+  regs.realesi:=tb_offset;
+  regs.realds:=tb_selector;
 {$ifndef RTLLITE}
-  if Win95 then
+  if LFNSupport then
    regs.realeax:=$7147
   else
 {$endif RTLLITE}
@@ -1034,13 +1049,24 @@ end;
 *****************************************************************************}
 
 {$ifndef RTLLITE}
-function CheckWin95:boolean;
+function CheckLFN:boolean;
 var
-  regs : TRealRegs;
+  regs     : TRealRegs;
+  Buffers,
+  RootName : pchar;
 begin
-  regs.realeax:=$160a;
-  sysrealintr($2f,regs);
-  CheckWin95:=(regs.realeax=0) and ((regs.realebx and $ff00)=$400);
+  RootName:='C:\'+#0;
+  Buffers:='                    '+#0;
+  syscopytodos(longint(RootName),strlen(RootName)+1);
+  regs.realeax:=$71a0;
+  regs.reales:=tb_selector;
+  regs.realedi:=tb_offset;
+  regs.realecx:=strlen(Buffers)+1;
+  regs.realds:=tb_selector;
+  regs.realedx:=tb_offset;
+  sysrealintr($21,regs);
+  syscopyfromdos(longint(Buffers),strlen(Buffers)+1);
+  CheckLFN:=(regs.realecx=255);
 end;
 {$endif RTLLITE}
 
@@ -1057,14 +1083,19 @@ Begin
 { Setup environment and arguments }
   Setup_Environment;
   Setup_Arguments;
-{ Use Win95 LFN }
-  Win95:=CheckWin95;
+{ Use LFNSupport LFN }
+  LFNSupport:=CheckLFN;
 { Reset IO Error }
   InOutRes:=0;
 End.
 {
   $Log$
-  Revision 1.15  1998-08-19 10:56:34  pierre
+  Revision 1.16  1998-08-26 10:04:03  peter
+    * new lfn check from mailinglist
+    * renamed win95 -> LFNSupport
+    + tb_selector, tb_offset for easier access to transferbuffer
+
+  Revision 1.15  1998/08/19 10:56:34  pierre
     + added some special code for C interface
       to avoid loading of crt1.o or dpmiexcp.o from the libc.a
 
@@ -1117,5 +1148,5 @@ End.
     * fix for smartlinking with _ARGS
 
   Revision 1.3  1998/05/04 16:21:54  florian
-    + win95 flag to the interface moved
+    + LFNSupport flag to the interface moved
 }