paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-06 14:50:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

* RTLLITE conditional added to produce smaller RTL.

Browse Source
This commit is contained in:
daniel 1998-06-15 15:17:08 +00:00
parent c48b67d0b3
commit b66d7560f1
1 changed files with 73 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

127
rtl/dos/go32v2/system.pp
View File

@ -50,8 +50,11 @@ var
argv : ppchar; argv : ppchar;
envp : ppchar; envp : ppchar;
dos_argv0 : pchar; dos_argv0 : pchar;
{$ifndef RTLLITE}
{ System info } { System info }
Win95 : boolean; Win95 : boolean;
{$endif RTLLITE}
type type
{ Dos Extender info } { Dos Extender info }
@ -165,7 +168,7 @@ _is_not_lowest:
{$endif SYSTEMDEBUG} {$endif SYSTEMDEBUG}
movl __stkbottom,%ebx movl __stkbottom,%ebx
cmpl %eax,%ebx cmpl %eax,%ebx
jae __short_on_stack jae __short_on_stack
popl %ebx popl %ebx
popl %eax popl %eax
leave leave
@ -241,7 +244,7 @@ end;
movw dseg,%ax movw dseg,%ax
movw %ax,%es movw %ax,%es
movw sseg,%ax movw sseg,%ax
movw %ax,%ds movw %ax,%ds
movl %ecx,%eax movl %ecx,%eax
shrl $2,%ecx shrl $2,%ecx
rep rep
@ -279,7 +282,7 @@ end;
rep rep
movsb movsb
incl %esi incl %esi
incl %edi incl %edi
.LSEG_MOVE1: .LSEG_MOVE1:
subl $4,%esi subl $4,%esi
subl $4,%edi subl $4,%edi
@ -301,7 +304,7 @@ begin
rv := 0; rv := 0;
while (s^ <>#0) do while (s^ <>#0) do
begin begin
v := ord(s^) - ord('0'); v := byte(s^) - byte('0');
if (v > 9) then v := v - 7; if (v > 9) then v := v - 7;
v := v and 15; { in case it's lower case } v := v and 15; { in case it's lower case }
rv := rv*16 + v; rv := rv*16 + v;
@ -313,11 +316,11 @@ end;
procedure setup_arguments; procedure setup_arguments;
type arrayword = array [0..0] of word; type arrayword = array [0..0] of word;
var psp : word; var psp : word;
i,j : byte; i,j : byte;
quote : char; quote : char;
proxy_s : string[7]; proxy_s : string[7];
tempargv : ppchar; tempargv : ppchar;
al,proxy_argc,proxy_seg,proxy_ofs,lin : longint; al,proxy_argc,proxy_seg,proxy_ofs,lin : longint;
largs : array[0..127] of pchar; largs : array[0..127] of pchar;
rm_argv : ^arrayword; rm_argv : ^arrayword;
begin begin
@ -339,7 +342,7 @@ for i:=1 to length(doscmd) do
quote := #0; quote := #0;
doscmd[i] := #0; doscmd[i] := #0;
largs[argc]:=@doscmd[j]; largs[argc]:=@doscmd[j];
inc(argc); inc(argc);
j := i+1; j := i+1;
end else end else
if (quote = #0) and ((doscmd[i] = '''') or (doscmd[i]='"')) then if (quote = #0) and ((doscmd[i] = '''') or (doscmd[i]='"')) then
@ -377,7 +380,7 @@ if (argc > 1) and (far_strlen(get_ds,longint(largs[1])) = 6) then
Writeln('proxy command line '); Writeln('proxy command line ');
{$EndIf SYSTEMDEBUG} {$EndIf SYSTEMDEBUG}
proxy_argc := atohex(largs[2]); proxy_argc := atohex(largs[2]);
proxy_seg := atohex(largs[3]); proxy_seg := atohex(largs[3]);
proxy_ofs := atohex(largs[4]); proxy_ofs := atohex(largs[4]);
getmem(rm_argv,proxy_argc*sizeof(word)); 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)); sysseg_move(dos_selector,proxy_seg*16+proxy_ofs, get_ds,longint(rm_argv),proxy_argc*sizeof(word));
@ -415,7 +418,7 @@ function strcopy(dest,source : pchar) : pchar;
movl 12(%ebp),%edi movl 12(%ebp),%edi
movl $0xffffffff,%ecx movl $0xffffffff,%ecx
xorb %al,%al xorb %al,%al
repne repne
scasb scasb
not %ecx not %ecx
movl 8(%ebp),%edi movl 8(%ebp),%edi
@ -475,7 +478,7 @@ begin
inc(longint(cp)); { skip to next character } inc(longint(cp)); { skip to next character }
end; end;
envp[env_count]:=nil; envp[env_count]:=nil;
inc(longint(cp),3); longint(cp):=longint(cp)+3;
getmem(dos_argv0,strlen(cp)+1); getmem(dos_argv0,strlen(cp)+1);
if (dos_argv0 = nil) then halt; if (dos_argv0 = nil) then halt;
strcopy(dos_argv0, cp); strcopy(dos_argv0, cp);
@ -491,7 +494,7 @@ end;
begin begin
if len > tb_size then runerror(217); if len > tb_size then runerror(217);
sysseg_move(dos_selector,tb,get_ds,addr,len); sysseg_move(dos_selector,tb,get_ds,addr,len);
end; end;
procedure sysrealintr(intnr : word;var regs : trealregs); procedure sysrealintr(intnr : word;var regs : trealregs);
@ -586,9 +589,11 @@ begin
syscopytodos(longint(p),strlen(p)+1); syscopytodos(longint(p),strlen(p)+1);
regs.realedx:=tb and 15; regs.realedx:=tb and 15;
regs.realds:=tb shr 4; regs.realds:=tb shr 4;
{$ifndef RTLLITE}
if Win95 then if Win95 then
regs.realeax:=$7141 regs.realeax:=$7141
else else
{$endif RTLLITE}
regs.realeax:=$4100; regs.realeax:=$4100;
regs.realesi:=0; regs.realesi:=0;
regs.realecx:=0; regs.realecx:=0;
@ -612,9 +617,11 @@ begin
regs.realedx:=tb and 15 + strlen(p2)+2; regs.realedx:=tb and 15 + strlen(p2)+2;
regs.realds:=tb shr 4; regs.realds:=tb shr 4;
regs.reales:=regs.realds; regs.reales:=regs.realds;
{$ifndef RTLLITE}
if Win95 then if Win95 then
regs.realeax:=$7156 regs.realeax:=$7156
else else
{$endif RTLLITE}
regs.realeax:=$5600; regs.realeax:=$5600;
regs.realecx:=$ff; { attribute problem here ! } regs.realecx:=$ff; { attribute problem here ! }
sysrealintr($21,regs); sysrealintr($21,regs);
@ -632,24 +639,24 @@ begin
writesize:=0; writesize:=0;
while len > 0 do while len > 0 do
begin begin
if len>tb_size then if len>tb_size then
size:=tb_size size:=tb_size
else else
size:=len; size:=len;
syscopytodos(addr+writesize,size); syscopytodos(addr+writesize,size);
regs.realecx:=size; regs.realecx:=size;
regs.realedx:=tb and 15; regs.realedx:=tb and 15;
regs.realds:=tb shr 4; regs.realds:=tb shr 4;
regs.realebx:=h; regs.realebx:=h;
regs.realeax:=$4000; regs.realeax:=$4000;
sysrealintr($21,regs); sysrealintr($21,regs);
if (regs.realflags and carryflag) <> 0 then if (regs.realflags and carryflag) <> 0 then
begin begin
InOutRes:=lo(regs.realeax); InOutRes:=lo(regs.realeax);
exit(writesize); exit(writesize);
end; end;
len:=len-size; len:=len-size;
writesize:=writesize+size; writesize:=writesize+size;
end; end;
Do_Write:=WriteSize Do_Write:=WriteSize
end; end;
@ -681,7 +688,7 @@ begin
exit; exit;
end end
else else
if regs.realeax<size then if regs.realeax<size then
begin begin
syscopyfromdos(addr+readsize,regs.realeax); syscopyfromdos(addr+readsize,regs.realeax);
do_read:=readsize+regs.realeax; do_read:=readsize+regs.realeax;
@ -795,7 +802,7 @@ begin
fminput,fmoutput,fminout : Do_Close(filerec(f).handle); fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
fmclosed : ; fmclosed : ;
else else
begin begin
inoutres:=102; {not assigned} inoutres:=102; {not assigned}
exit; exit;
end; end;
@ -830,9 +837,11 @@ begin
end; end;
{ real dos call } { real dos call }
syscopytodos(longint(p),strlen(p)+1); syscopytodos(longint(p),strlen(p)+1);
{$ifndef RTLLITE}
if Win95 then if Win95 then
regs.realeax:=$716c regs.realeax:=$716c
else else
{$endif RTLLITE}
regs.realeax:=$6c00; regs.realeax:=$6c00;
regs.realedx:=action; regs.realedx:=action;
regs.realds:=tb shr 4; regs.realds:=tb shr 4;
@ -842,27 +851,27 @@ begin
sysrealintr($21,regs); sysrealintr($21,regs);
if (regs.realflags and carryflag) <> 0 then if (regs.realflags and carryflag) <> 0 then
begin begin
InOutRes:=lo(regs.realeax); InOutRes:=lo(regs.realeax);
exit; exit;
end end
else else
filerec(f).handle:=regs.realeax; filerec(f).handle:=regs.realeax;
{ append mode } { append mode }
if (flags and $10)<>0 then if (flags and $10)<>0 then
begin begin
do_seekend(filerec(f).handle); do_seekend(filerec(f).handle);
filerec(f).mode:=fmoutput; {fool fmappend} filerec(f).mode:=fmoutput; {fool fmappend}
end; end;
end; end;
{***************************************************************************** {*****************************************************************************
UnTyped File Handling UnTyped File Handling
*****************************************************************************} *****************************************************************************}
{$i file.inc} {$i file.inc}
{***************************************************************************** {*****************************************************************************
Typed File Handling Typed File Handling
*****************************************************************************} *****************************************************************************}
{$i typefile.inc} {$i typefile.inc}
@ -890,9 +899,11 @@ begin
syscopytodos(longint(@buffer),length(s)+1); syscopytodos(longint(@buffer),length(s)+1);
regs.realedx:=tb and 15; regs.realedx:=tb and 15;
regs.realds:=tb shr 4; regs.realds:=tb shr 4;
{$ifndef RTLLITE}
if Win95 then if Win95 then
regs.realeax:=$7100+func regs.realeax:=$7100+func
else else
{$endif RTLLITE}
regs.realeax:=func shl 8; regs.realeax:=func shl 8;
sysrealintr($21,regs); sysrealintr($21,regs);
if (regs.realflags and carryflag) <> 0 then if (regs.realflags and carryflag) <> 0 then
@ -927,15 +938,17 @@ begin
regs.realedx:=drivenr; regs.realedx:=drivenr;
regs.realesi:=tb and 15; regs.realesi:=tb and 15;
regs.realds:=tb shr 4; regs.realds:=tb shr 4;
{$ifndef RTLLITE}
if Win95 then if Win95 then
regs.realeax:=$7147 regs.realeax:=$7147
else else
{$endif RTLLITE}
regs.realeax:=$4700; regs.realeax:=$4700;
sysrealintr($21,regs); sysrealintr($21,regs);
if (regs.realflags and carryflag) <> 0 then if (regs.realflags and carryflag) <> 0 then
Begin Begin
InOutRes:=lo(regs.realeax); InOutRes:=lo(regs.realeax);
exit; exit;
end end
else else
syscopyfromdos(longint(@temp),251); syscopyfromdos(longint(@temp),251);
@ -943,34 +956,35 @@ begin
i:=0; i:=0;
while (temp[i]<>#0) do while (temp[i]<>#0) do
begin begin
if temp[i]='/' then if temp[i]='/' then
temp[i]:='\'; temp[i]:='\';
dir[i+4]:=temp[i]; dir[i+4]:=temp[i];
inc(i); inc(i);
end; end;
dir[2]:=':'; dir[2]:=':';
dir[3]:='\'; dir[3]:='\';
dir[0]:=chr(i+3); dir[0]:=char(i+3);
{ upcase the string } { upcase the string }
dir:=upcase(dir); dir:=upcase(dir);
if drivenr<>0 then { Drive was supplied. We know it } if drivenr<>0 then { Drive was supplied. We know it }
dir[1]:=chr(65+drivenr-1) dir[1]:=char(65+drivenr-1)
else else
begin begin
{ We need to get the current drive from DOS function 19H } { We need to get the current drive from DOS function 19H }
{ because the drive was the default, which can be unknown } { because the drive was the default, which can be unknown }
regs.realeax:=$1900; regs.realeax:=$1900;
sysrealintr($21,regs); sysrealintr($21,regs);
i:= (regs.realeax and $ff) + ord('A'); i:= (regs.realeax and $ff) + ord('A');
dir[1]:=chr(i); dir[1]:=chr(i);
end; end;
end; end;
{***************************************************************************** {*****************************************************************************
SystemUnit Initialization SystemUnit Initialization
*****************************************************************************} *****************************************************************************}
{$ifndef RTLLITE}
function CheckWin95:boolean; function CheckWin95:boolean;
var var
regs : TRealRegs; regs : TRealRegs;
@ -979,6 +993,7 @@ begin
sysrealintr($2f,regs); sysrealintr($2f,regs);
CheckWin95:=(regs.realeax=0) and ((regs.realebx and $ff00)=$400); CheckWin95:=(regs.realeax=0) and ((regs.realebx and $ff00)=$400);
end; end;
{$endif RTLLITE}
procedure OpenStdIO(var f:text;mode:word;hdl:longint); procedure OpenStdIO(var f:text;mode:word;hdl:longint);
@ -1013,7 +1028,11 @@ Begin
End. End.
{ {
$Log$ $Log$
Revision 1.6 1998-05-31 14:18:29 peter 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
* force att or direct assembling * force att or direct assembling
* cleanup of some files * cleanup of some files