From 0c1893bc2afc847bbd544748b28aefe6ddabe155 Mon Sep 17 00:00:00 2001 From: carl Date: Fri, 23 Nov 2001 00:25:39 +0000 Subject: [PATCH] * updated behavior of some routines to conform to docs --- rtl/amiga/dos.pp | 318 +++++++++++++++++++++++++++------------------- rtl/go32v1/dos.pp | 13 +- 2 files changed, 188 insertions(+), 143 deletions(-) diff --git a/rtl/amiga/dos.pp b/rtl/amiga/dos.pp index f6e3a0b9e2..c275ce7646 100644 --- a/rtl/amiga/dos.pp +++ b/rtl/amiga/dos.pp @@ -1,7 +1,7 @@ { $Id$ This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by Nils Sjoholm and Carl Eric Codere + Copyright (c) 1998-2001 by Nils Sjoholm and Carl Eric Codere members of the Free Pascal development team Date conversion routine taken from SWAG @@ -103,14 +103,20 @@ Type Sec: word; End; + registers = packed record + case i : integer of + 0 : (ax,f1,bx,f2,cx,f3,dx,f4,bp,f5,si,f51,di,f6,ds,f7,es,f8,flags,fs,gs : word); + 1 : (al,ah,f9,f10,bl,bh,f11,f12,cl,ch,f13,f14,dl,dh : byte); + 2 : (eax, ebx, ecx, edx, ebp, esi, edi : longint); + end; Var DosError : integer; {Interrupt} -{Procedure Intr(intno: byte; var regs: registers); -Procedure MSDos(var regs: registers);} +Procedure Intr(intno: byte; var regs: registers); +Procedure MSDos(var regs: registers); {Info/Date/Time} Function DosVersion: Word; @@ -244,10 +250,10 @@ Type tc_State : Byte; tc_IDNestCnt : Shortint; { intr disabled nesting } tc_TDNestCnt : Shortint; { task disabled nesting } - tc_SigAlloc : Cardinal; { sigs allocated } - tc_SigWait : Cardinal; { sigs we are waiting for } - tc_SigRecvd : Cardinal; { sigs we have received } - tc_SigExcept : Cardinal; { sigs we will take excepts for } + tc_SigAlloc : longint; { sigs allocated } + tc_SigWait : longint; { sigs we are waiting for } + tc_SigRecvd : longint; { sigs we have received } + tc_SigExcept : longint; { sigs we will take excepts for } tc_TrapAlloc : Word; { traps allocated } tc_TrapAble : Word; { traps enabled } tc_ExceptData : Pointer; { points to except data } @@ -328,38 +334,29 @@ Type lib_OpenCnt : Word; { number of current opens } end; { * Warning: size is not a longword multiple ! * } - pAChain = ^tAChain; - tAChain = packed record - an_Child, - an_Parent : pAChain; - an_Lock : BPTR; - an_Info : tFileInfoBlock; - an_Flags : Shortint; - an_String : Array[0..0] of Char; { FIX!! } - END; + PChain = ^TChain; + TChain = packed record + an_Child : PChain; + an_Parent: PChain; + an_Lock : BPTR; + an_info : TFileInfoBlock; + an_Flags : shortint; + an_string: Array[0..0] of char; + end; - pAnchorPath = ^tAnchorPath; - tAnchorPath = packed record - case integer of - 0 : ( - ap_First : pAChain; - ap_Last : pAChain; - ); - 1 : ( - ap_Base, { pointer to first anchor } - ap_Current : pAChain; { pointer to last anchor } - ap_BreakBits, { Bits we want to break on } - ap_FoundBreak : Longint; { Bits we broke on. Also returns ERROR_BREAK } - ap_Flags : Shortint; { New use for extra Integer. } - ap_Reserved : Shortint; - ap_Strlen : Integer; { This is what ap_Length used to be } - ap_Info : tFileInfoBlock; - ap_Buf : Array[0..0] of Char; { Buffer for path name, allocated by user !! } - { FIX! } - ); - END; - + PAnchorPath = ^TAnchorPath; + TAnchorPath = packed record + ap_Base : PChain; {* pointer to first anchor *} + ap_First : PChain; {* pointer to last anchor *} + ap_BreakBits : LONGINT; {* Bits we want to break on *} + ap_FondBreak : LONGINT; {* Bits we broke on. Also returns ERROR_BREAK *} + ap_Flags : shortint; {* New use for extra word. *} + ap_reserved : BYTE; + ap_StrLen : WORD; + ap_Info : TFileInfoBlock; + ap_Buf : Array[0..0] of Char; {* Buffer for path name, allocated by user *} + END; pCommandLineInterface = ^TCommandLineInterface; TCommandLineInterface = packed record @@ -381,50 +378,16 @@ Type cli_Module : BPTR; {* SegList of currently loaded command*} END; - { structure used for multi-directory assigns. AllocVec()ed. } - - pAssignList = ^tAssignList; - tAssignList = packed record - al_Next : pAssignList; - al_Lock : BPTR; - END; - - pDosList = ^tDosList; + pDosList = ^tDosList; tDosList = packed record dol_Next : BPTR; { bptr to next device on list } dol_Type : Longint; { see DLT below } - dol_Task : pMsgPort; { ptr to handler task } + dol_Task : Pointer; { ptr to handler task } dol_Lock : BPTR; - case integer of - 0 : ( - dol_Handler : record - dol_Handler : BSTR; { file name to load IF seglist is null } - dol_StackSize, { stacksize to use when starting process } - dol_Priority, { task priority when starting process } - dol_Startup : Longint; { startup msg: FileSysStartupMsg for disks } - dol_SegList, { already loaded code for new task } - dol_GlobVec : BPTR; { BCPL global vector to use when starting - * a process. -1 indicates a C/Assembler - * program. } - end; - ); - 1 : ( - dol_Volume : record - dol_VolumeDate : tDateStamp; { creation date } - dol_LockList : BPTR; { outstanding locks } - dol_DiskType : Longint; { 'DOS', etc } - END; - ); - 2 : ( - dol_assign : record - dol_AssignName : PChar; { name for non-OR-late-binding assign } - dol_List : pAssignList; { for multi-directory assigns (regular) } - END; + dol_Misc : Array[0..23] of Shortint; dol_Name : BSTR; { bptr to bcpl name } - ); END; - TProcess = packed record pr_Task : TTask; pr_MsgPort : TMsgPort; { This is BPTR address from DOS functions } @@ -695,7 +658,7 @@ Function _Execute(p: pchar): longint; end; end; -FUNCTION LockDosList(flags : CARDINAL) : pDosList; +FUNCTION LockDosList(flags : longint) : pDosList; BEGIN ASM MOVE.L A6,-(A7) @@ -708,7 +671,7 @@ BEGIN END; -PROCEDURE UnLockDosList(flags : CARDINAL); +PROCEDURE UnLockDosList(flags : longint); BEGIN ASM MOVE.L A6,-(A7) @@ -720,7 +683,7 @@ BEGIN END; -FUNCTION NextDosEntry(dlist : pDosList; flags : CARDINAL) : pDosList; +FUNCTION NextDosEntry(dlist : pDosList; flags : longint) : pDosList; BEGIN ASM MOVE.L A6,-(A7) @@ -898,10 +861,10 @@ End; --- Dos Interrupt --- ******************************************************************************} -(*Procedure Intr (intno: byte; var regs: registers); +Procedure Intr (intno: byte; var regs: registers); Begin { Does not apply to Linux - not implemented } - End;*) + End; Procedure SwapVectors; @@ -910,10 +873,10 @@ Procedure SwapVectors; End; -(*Procedure msdos(var regs : registers); +Procedure msdos(var regs : registers); Begin { ! Not implemented in Linux ! } - End;*) + End; Procedure getintvec(intno : byte;var vector : pointer); @@ -1000,8 +963,6 @@ end; Var LastDosExitCode: word; - breakflag : Boolean; - ver: Boolean; Procedure Exec (Const Path: PathStr; Const ComLine: ComStr); @@ -1051,25 +1012,24 @@ Function DosExitCode: Word; Procedure GetCBreak(Var BreakValue: Boolean); Begin - breakvalue:=breakflag; + breakvalue := system.BreakOn; End; Procedure SetCBreak(BreakValue: Boolean); Begin - breakflag:=BreakValue; + system.Breakon := BreakValue; End; Procedure GetVerify(Var Verify: Boolean); Begin - verify:=ver; + verify:=true; End; Procedure SetVerify(Verify: Boolean); Begin - ver:=Verify; End; {****************************************************************************** @@ -1285,7 +1245,7 @@ Begin Begin MatchEnd(f.AnchorPtr); if assigned(f.AnchorPtr) then - Dispose(f.AnchorPtr); + {Dispose}FreeMem(f.AnchorPtr); end else { Fill up the Searchrec information } @@ -1331,42 +1291,32 @@ End; Procedure FSplit(path: pathstr; var dir: dirstr; var name: namestr; var ext: extstr); var - p1,i : longint; + I: Word; begin - { allow slash as backslash } + { allow backslash as slash } for i:=1 to length(path) do - if path[i]='\' then path[i]:='/'; - { get drive name } - p1:=pos(':',path); - if p1>0 then - begin - dir:=copy(path,1,p1); - delete(path,1,p1); - end - else - dir:=''; - { split the path and the name, there are no more path informtions } - { if path contains no backslashes } - while true do - begin - p1:=pos('/',path); - if p1=0 then - break; - dir:=dir+copy(path,1,p1); - delete(path,1,p1); - end; - { try to find out a extension } - p1:=pos('.',path); - if p1>0 then - begin - ext:=copy(path,p1,4); - delete(path,p1,length(path)-p1+1); - end - else - ext:=''; - name:=path; -end; + if path[i]='\' then path[i]:='/'; + I := Length(Path); + while (I > 0) and not ((Path[I] = '/') or (Path[I] = ':')) + do Dec(I); + if Path[I] = '/' then + dir := Copy(Path, 0, I) + else dir := Copy(Path,0,I); + + if Length(Path) > Length(dir) then + name := Copy(Path, I + 1, Length(Path)-I) + else + name := ''; + { Remove extension } + if pos('.',name) <> 0 then + delete(name,pos('.',name),length(name)); + + I := Pos('.',Path); + if I > 0 then + ext := Copy(Path,I,Length(Path)-(I-1)) + else ext := ''; +end; Function FExpand(Path: PathStr): PathStr; var @@ -1609,6 +1559,45 @@ Procedure setfattr (var f;attr : word); --- Environment --- ******************************************************************************} +var +StrofPaths : string[255]; + +function getpathstring: string; +var + f : text; + s : string; + found : boolean; + temp : string[255]; +begin + found := true; + temp := ''; + assign(f,'ram:makepathstr'); + rewrite(f); + writeln(f,'path >ram:temp.lst'); + close(f); + exec('c:protect','ram:makepathstr sarwed'); + exec('C:execute','ram:makepathstr'); + exec('c:delete','ram:makepathstr quiet'); + assign(f,'ram:temp.lst'); + reset(f); + { skip the first line, garbage } + if not eof(f) then readln(f,s); + while not eof(f) do begin + readln(f,s); + if found then begin + temp := s; + found := false; + end else begin; + if (length(s) + length(temp)) < 255 then + temp := temp + ';' + s; + end; + end; + close(f); + exec('C:delete','ram:temp.lst quiet'); + getpathstring := temp; +end; + + Function EnvCount: Longint; { HOW TO GET THIS VALUE: } { Each time this function is called, we look at the } @@ -1627,18 +1616,21 @@ Procedure setfattr (var f;attr : word); function GetEnv(envvar : String): String; var - buffer : Pchar; bufarr : array[0..255] of char; strbuffer : array[0..255] of char; temp : Longint; begin - move(envvar[1],strbuffer,length(envvar)); - strbuffer[length(envvar)] := #0; - buffer := @bufarr; - temp := GetVar(strbuffer,buffer,255,$100); - if temp = -1 then - GetEnv := '' - else GetEnv := StrPas(buffer); + if UpCase(envvar) = 'PATH' then begin + if StrOfpaths = '' then StrOfPaths := GetPathString; + GetEnv := StrofPaths; + end else begin + move(envvar,strbuffer,length(envvar)); + strbuffer[length(envvar)] := #0; + temp := GetVar(strbuffer,bufarr,255,$100); + if temp = -1 then + GetEnv := '' + else GetEnv := StrPas(bufarr); + end; end; @@ -1710,9 +1702,8 @@ end; Begin DosError:=0; - ver:=TRUE; - breakflag:=TRUE; numberofdevices := 0; + StrOfPaths := ''; AddDevice('DF0:'); AddDevice('DF1:'); AddDevice('DF2:'); @@ -1722,7 +1713,66 @@ End. { $Log$ - Revision 1.2 2000-07-13 11:33:35 michael - + removed logs - + Revision 1.3 2001-11-23 00:25:39 carl + * updated behavior of some routines to conform to docs + + Revision 1.1.2.2 2001/07/24 07:32:25 pierre + * Use FreeMem on untyped pointer instead of dispose + + Revision 1.1.2.1 2001/03/27 03:12:57 carl + + more routines are implemented (from Nils - thanks!) + ? Is the problem with illegal memory read fixed? + + Revision 1.8 1998/08/19 14:52:52 carl + * SearchRec was not aligned!! so BOUM!... + + Revision 1.7 1998/08/17 12:30:42 carl + * FExpand removes dot characters + * Findfirst single/double dot expansion + + SetFtime implemented + + Revision 1.6 1998/08/13 13:18:45 carl + * FSearch bugfix + * FSplit bugfix + + GetFAttr,SetFAttr and GetFTime accept dos dir separators + + Revision 1.5 1998/08/04 13:37:10 carl + * bugfix of findfirst, was not convberting correctl backslahes + + History (Nils Sjoholm): + 10.02.1998 First version for Amiga. + Just GetDate and GetTime. + + 11.02.1998 Added AmigaToDt and DtToAmiga + Changed GetDate and GetTime to + use AmigaToDt and DtToAmiga. + + Added DiskSize and DiskFree. + They are using a string as arg + have to try to fix that. + + 12.02.1998 Added Fsplit and FExpand. + Cleaned up the unit and removed + stuff that was not used yet. + + 13.02.1998 Added CToPas and PasToC and removed + the uses of strings. + + 14.02.1998 Removed AmigaToDt and DtToAmiga + from public area. + Added deviceids and devicenames + arrays so now diskfree and disksize + is compatible with dos. + + + } + + + + + + + + + diff --git a/rtl/go32v1/dos.pp b/rtl/go32v1/dos.pp index c568dc790b..48e80a5f0f 100644 --- a/rtl/go32v1/dos.pp +++ b/rtl/go32v1/dos.pp @@ -256,7 +256,6 @@ begin dosregs.dl:=day; dosregs.ah:=$2b; msdos(dosregs); - DosError:=0; end; @@ -268,7 +267,6 @@ begin minute:=dosregs.cl; second:=dosregs.dh; sec100:=dosregs.dl; - DosError:=0; end; @@ -344,7 +342,6 @@ end; procedure getcbreak(var breakvalue : boolean); begin - DosError:=0; dosregs.ax:=$3300; msdos(dosregs); breakvalue:=dosregs.dl<>0; @@ -353,7 +350,6 @@ end; procedure setcbreak(breakvalue : boolean); begin - DosError:=0; dosregs.ax:=$3301; dosregs.dl:=ord(breakvalue); msdos(dosregs); @@ -362,7 +358,6 @@ end; procedure getverify(var verify : boolean); begin - DosError:=0; dosregs.ah:=$54; msdos(dosregs); verify:=dosregs.al<>0; @@ -371,7 +366,6 @@ end; procedure setverify(verify : boolean); begin - DosError:=0; dosregs.ah:=$2e; dosregs.al:=ord(verify); msdos(dosregs); @@ -384,7 +378,6 @@ end; function diskfree(drive : byte) : longint; begin - DosError:=0; dosregs.dl:=drive; dosregs.ah:=$36; msdos(dosregs); @@ -397,7 +390,6 @@ end; function disksize(drive : byte) : longint; begin - DosError:=0; dosregs.dl:=drive; dosregs.ah:=$36; msdos(dosregs); @@ -709,7 +701,10 @@ End; end. { $Log$ - Revision 1.3 2001-03-10 09:57:51 hajny + Revision 1.4 2001-11-23 00:27:22 carl + * updated behavior of some routines to conform to docs + + Revision 1.3 2001/03/10 09:57:51 hajny * FExpand without IOResult change, remaining direct asm removed Revision 1.2 2000/07/13 11:33:38 michael