|
@@ -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,9 +718,10 @@ 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
|
|
|
|
|
- ___v2prt0_ds_alias : word;external name '___v2prt0_ds_alias';
|
|
|
|
|
|
|
|
|
|
|
|
+ var
|
|
|
|
|
+ ___v2prt0_ds_alias : word; external name '___v2prt0_ds_alias';
|
|
|
|
|
+
|
|
|
function get_rm_callback(pm_func : pointer;const reg : trealregs;var rmcb : tseginfo) : boolean;
|
|
function get_rm_callback(pm_func : pointer;const reg : trealregs;var rmcb : tseginfo) : boolean;
|
|
|
begin
|
|
begin
|
|
|
asm
|
|
asm
|
|
@@ -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);
|
|
@@ -942,7 +956,7 @@ end ['EAX','EDX'];
|
|
|
var
|
|
var
|
|
|
linearaddr : longint;
|
|
linearaddr : longint;
|
|
|
begin
|
|
begin
|
|
|
- if get_run_mode <>rm_dpmi then
|
|
|
|
|
|
|
+ if get_run_mode<>rm_dpmi then
|
|
|
exit;
|
|
exit;
|
|
|
linearaddr:=longint(functionaddr)+get_segment_base_address(get_cs);
|
|
linearaddr:=longint(functionaddr)+get_segment_base_address(get_cs);
|
|
|
unlock_code:=unlock_linear_region(linearaddr,size);
|
|
unlock_code:=unlock_linear_region(linearaddr,size);
|
|
@@ -1084,10 +1098,7 @@ end ['EAX','EDX'];
|
|
|
function get_run_mode : word;
|
|
function get_run_mode : word;
|
|
|
|
|
|
|
|
begin
|
|
begin
|
|
|
- asm
|
|
|
|
|
- movw _run_mode,%ax
|
|
|
|
|
- movw %ax,__RESULT
|
|
|
|
|
- end ['EAX'];
|
|
|
|
|
|
|
+ get_run_mode:=_run_mode;
|
|
|
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
|
pierre