From 2f3bc2f300809fa18186f60f07339649affea776 Mon Sep 17 00:00:00 2001 From: peter Date: Wed, 26 Aug 1998 10:04:01 +0000 Subject: [PATCH] * new lfn check from mailinglist * renamed win95 -> LFNSupport + tb_selector, tb_offset for easier access to transferbuffer --- rtl/dos/dos.pp | 65 +++++++++++++----------- rtl/dos/go32.pp | 65 ++++++++++++++---------- rtl/dos/go32v2/system.pp | 105 +++++++++++++++++++++++++-------------- 3 files changed, 142 insertions(+), 93 deletions(-) diff --git a/rtl/dos/dos.pp b/rtl/dos/dos.pp index 08acc2053b..393d787f7a 100644 --- a/rtl/dos/dos.pp +++ b/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 diff --git a/rtl/dos/go32.pp b/rtl/dos/go32.pp index 9fc9cb6deb..2a1aea1253 100644 --- a/rtl/dos/go32.pp +++ b/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} + +{***************************************************************************** + 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 diff --git a/rtl/dos/go32v2/system.pp b/rtl/dos/go32v2/system.pp index ab422fc20c..33ad1b9524 100644 --- a/rtl/dos/go32v2/system.pp +++ b/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 }