paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 10:29:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

- Port[] moved to ports.pp unit

Browse Source 
* global_dos_alloc returns zero and set int31error
    if DPMI call fails
This commit is contained in:
pierre 1999-09-09 07:13:29 +00:00
parent 07936d54b8
commit 5232a28009
1 changed files with 46 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
rtl/go32v2/go32.pp
View File

@ -15,7 +15,9 @@
unit go32; unit go32;
{$ifdef SUPPORT_PORTS}
{$Mode ObjFpc} {$Mode ObjFpc}
{$endif SUPPORT_PORTS}
{$S-,R-,I-,Q-} {no stack check, used by DPMIEXCP !! } {$S-,R-,I-,Q-} {no stack check, used by DPMIEXCP !! }
interface interface
@ -173,6 +175,7 @@ interface
procedure dpmi_dosmemfillword(seg,ofs : word;count : longint;w : word); procedure dpmi_dosmemfillword(seg,ofs : word;count : longint;w : word);
{$ifdef SUPPORT_PORTS}
type type
tport = class tport = class
procedure writeport(p : word;data : byte); procedure writeport(p : word;data : byte);
@ -198,6 +201,7 @@ var
portb : tport; portb : tport;
portw : tportw; portw : tportw;
portl : tportl; portl : tportl;
{$endif SUPPORT_PORTS}
const const
{ this procedures are assigned to the procedure which are needed } { this procedures are assigned to the procedure which are needed }
@ -245,6 +249,25 @@ var
seg_fillword(dosmemselector,seg*16+ofs,count,w); seg_fillword(dosmemselector,seg*16+ofs,count,w);
end; end;
procedure test_int31(flag : longint);
begin
asm
pushl %ebx
movw $0,INT31ERROR
movl flag,%ebx
testb $1,%bl
jz .Lti31_1
movw %ax,INT31ERROR
xorl %eax,%eax
jmp .Lti31_2
.Lti31_1:
movl $1,%eax
.Lti31_2:
popl %ebx
end;
end;
function global_dos_alloc(bytes : longint) : longint; function global_dos_alloc(bytes : longint) : longint;
begin begin
@ -254,8 +277,14 @@ var
shrl $0x4,%ebx // convert to Paragraphs shrl $0x4,%ebx // convert to Paragraphs
movl $0x100,%eax // function 0x100 movl $0x100,%eax // function 0x100
int $0x31 int $0x31
jnc .LDos_OK
movw %ax,INT31ERROR
xorl %eax,%eax
jmp .LDos_end
.LDos_OK:
shll $0x10,%eax // return Segment in hi(Result) shll $0x10,%eax // return Segment in hi(Result)
movw %dx,%ax // return Selector in lo(Result) movw %dx,%ax // return Selector in lo(Result)
.LDos_end:
movl %eax,__result movl %eax,__result
end; end;
end; end;
@ -476,6 +505,7 @@ var
end; end;
{$ifdef SUPPORT_PORTS}
{ to give easy port access like tp with port[] } { to give easy port access like tp with port[] }
procedure tport.writeport(p : word;data : byte);assembler; procedure tport.writeport(p : word;data : byte);assembler;
@ -522,6 +552,7 @@ asm
inl %dx,%eax inl %dx,%eax
end ['EAX','EDX']; end ['EAX','EDX'];
{$endif SUPPORT_PORTS}
function get_cs : word;assembler; function get_cs : word;assembler;
asm asm
@ -541,24 +572,6 @@ end ['EAX','EDX'];
end; end;
procedure test_int31(flag : longint);
begin
asm
pushl %ebx
movw $0,INT31ERROR
movl flag,%ebx
testb $1,%bl
jz .Lti31_1
movw %ax,INT31ERROR
xorl %eax,%eax
jmp .Lti31_2
.Lti31_1:
movl $1,%eax
.Lti31_2:
popl %ebx
end;
end;
function set_pm_interrupt(vector : byte;const intaddr : tseginfo) : boolean; function set_pm_interrupt(vector : byte;const intaddr : tseginfo) : boolean;
begin begin
@ -705,6 +718,7 @@ end ['EAX','EDX'];
{ here we must use ___v2prt0_ds_alias instead of from v2prt0.s { here we must use ___v2prt0_ds_alias instead of from v2prt0.s
because the exception processor sets the ds limit to $fff because the exception processor sets the ds limit to $fff
at hardware exceptions } at hardware exceptions }
var var
___v2prt0_ds_alias : word; external name '___v2prt0_ds_alias'; ___v2prt0_ds_alias : word; external name '___v2prt0_ds_alias';
@ -890,7 +904,7 @@ end ['EAX','EDX'];
linearaddr : longint; linearaddr : longint;
begin begin
if get_run_mode <> 4 then if get_run_mode<>rm_dpmi then
exit; exit;
linearaddr:=longint(@data)+get_segment_base_address(get_ds); linearaddr:=longint(@data)+get_segment_base_address(get_ds);
lock_data:=lock_linear_region(linearaddr,size); lock_data:=lock_linear_region(linearaddr,size);
@ -1084,10 +1098,7 @@ end ['EAX','EDX'];
function get_run_mode : word; function get_run_mode : word;
begin begin
asm get_run_mode:=_run_mode;
movw _run_mode,%ax
movw %ax,__RESULT
end ['EAX'];
end; end;
function map_device_in_memory_block(handle,offset,pagecount,device:longint):boolean; function map_device_in_memory_block(handle,offset,pagecount,device:longint):boolean;
@ -1106,19 +1117,6 @@ end ['EAX','EDX'];
end; end;
end; end;
var
_core_selector : word;external name '_core_selector';
function get_core_selector : word;
begin
asm
movw _core_selector,%ax
movw %ax,__RESULT
end;
end;
{***************************************************************************** {*****************************************************************************
Transfer Buffer Transfer Buffer
*****************************************************************************} *****************************************************************************}
@ -1163,15 +1161,22 @@ end ['EAX','EDX'];
end; end;
var
_core_selector : word;external name '_core_selector';
begin begin
int31error:=0; int31error:=0;
dosmemselector:=get_core_selector; dosmemselector:=_core_selector;
end. end.
{ {
$Log$ $Log$
Revision 1.4 1999-05-13 21:54:27 peter Revision 1.5 1999-09-09 07:13:29 pierre
- Port[] moved to ports.pp unit
* global_dos_alloc returns zero and set int31error
if DPMI call fails
Revision 1.4 1999/05/13 21:54:27 peter
* objpas fixes * objpas fixes
Revision 1.3 1999/03/26 00:01:52 peter Revision 1.3 1999/03/26 00:01:52 peter