paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-20 15:49:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

erged from fixbranch

Browse Source
This commit is contained in:
michael 2000-09-24 08:21:35 +00:00
parent 404e950ed4
commit 4867ef1577
26 changed files with 1629 additions and 1334 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

98
docs/go32ex/buffer.pas
View File

@ -1,22 +1,12 @@
{ example for :
global_dos_alloc()
global_dos_free()
trealregs / registers record
realintr()
DOS memory access
dosmemput()
dosmemget()
int31error variable
}
{ This program demonstrates the usage of DOS real mode memory by
executing a software interrupt which needs a buffer to store data
into. Because these interrupts are real mode funcs, the buffer must
be located in real mode memory space (first MB of memory). Such
memory can only be allocated by the global_dos_alloc() and
global_dos_free() functions of the GO32 unit.
{ This program demonstrates the usage of DOS real mode memory by executing a
software interrupt which needs a buffer to store data into. Because these
interrupts are real mode funcs, the buffer must be located in real mode
memory space (first MB of memory). Such memory can only be allocated by
the global_dos_alloc() and global_dos_free() functions of the GO32 unit.
In more detail this program tries to detect a VESA 2.0 BIOS extension of
your graphics card and outputs its version.
In more detail this program tries to detect a VESA 2.0 BIOS
extension of your graphics card and outputs its version.
Here's the necessary interrupt call description:
@ -28,57 +18,70 @@
Buffer structure : (relevant to this example)
must be 'VESA' in the first 4 chars of the buffer to be valid
VBE version in the next word
must be 'VESA' in the first 4 chars of the buffer to be
valid VBE version in the next word
Note : to request VBE 2.0 information, the first 4 bytes of the buffer must
contain 'VBE2' prior to the interrupt call.
Note : to request VBE 2.0 information, the first 4 bytes of the
buffer must contain 'VBE2' prior to the interrupt call.
(this makes the problem a bit tougher; we first have to copy the
buffer with the 'VBE2' id to dos memory...)
}
uses go32;
uses
go32;
{ The following 2 functions are wrappers to the GO32 global_dos_alloc() and
global_dos_free() functions to simplify their usage }
{The following 2 functions are wrappers to the GO32
global_dos_alloc() and global_dos_free() functions to simplify their
usage }
{ Function : dosalloc }
{ Input : size of a real mode location }
{ Output : selector and segment of a real mode location }
procedure dosalloc(var selector : word; var segment : word; size : longint);
var res : longint;
procedure dosalloc(var selector : word;
var segment : word; size : longint);
var
res : longint;
begin
{ try to allocate real mode memory }
res := global_dos_alloc(size);
{ the lower 16 bits of the result contain the selector to the allocated
memory block }
{ the lower 16 bits of the result contain the selector to the
allocated memory block }
selector := word(res);
{ the upper 16 bits contain the real mode segment address of this block;
the offset is always 0, so we don't need to return this }
{ the upper 16 bits contain the real mode segment address of
this block; the offset is always 0, so we don't need to return
this }
segment := word(res shr 16);
end;
{ Function : dosfree }
{ Input : selector of a real mode block }
{ Output : none }
{ Description : de-allocates a previously allocated real mode memory }
{ Description : de-allocates a previously allocated real mode
memory}
procedure dosfree(selector : word);
begin
{ call the GO32 function with the selector }
global_dos_free(selector);
end;
type VBEInfoBuf = record
Signature : array[0..3] of char; { contains 'VESA' if successful }
type
VBEInfoBuf = packed record
{ contains 'VESA' if successful }
Signature : array[0..3] of char;
Version : Word;
reserved : array[0..505] of byte; { pad to 512 bytes length }
{ pad to 512 bytes length }
reserved : array[0..505] of byte;
end;
var selector, { selector to our real mode buffer }
segment : Word; { real mode segment address of buffer }
var
{ selector to our real mode buffer }
selector,
{ real mode segment address of buffer }
segment : Word;
r : trealregs; { register structure to issue a software interrupt }
{ register structure to issue a software interrupt }
r : trealregs;
infobuf : VBEInfoBuf;
begin
@ -101,18 +104,23 @@ begin
realintr($10, r);
{ copy buffer to our infobuf variable again }
dosmemget(segment, 0, infobuf, sizeof(infobuf));
{ free allocated real mode memory, because we don't need it anymore }
{ free allocated real mode memory, because we don't need it
anymore }
dosfree(selector);
{ check if interrupt call was successful }
if (r.ax <> $4f) then begin
{ write message and exit, because the infobuf doesn't contain any
useful data we could tell the user }
Writeln('VBE BIOS extension not available, function call failed');
{ write message and exit, because the infobuf doesn't contain
any useful data we could tell the user }
Writeln('VBE BIOS extension not available, function call ',
'failed');
halt;
end;
{ check if buffer is valid }
if (infobuf.signature[0] = 'V') and (infobuf.signature[1] = 'E') and
(infobuf.signature[2] = 'S') and (infobuf.signature[3] = 'A') then begin
Writeln('VBE version ', hi(infobuf.version), '.', lo(infobuf.version), ' detected');
if (infobuf.signature[0] = 'V') and
(infobuf.signature[1] = 'E') and
(infobuf.signature[2] = 'S') and
(infobuf.signature[3] = 'A') then begin
Writeln('VBE version ', hi(infobuf.version), '.',
lo(infobuf.version), ' detected');
end;
end.

29
docs/go32ex/buffer.pp
View File

@ -1,9 +1,10 @@
Program buffer;
uses
go32;
uses go32;
procedure dosalloc(var selector : word; var segment : word; size : longint);
var res : longint;
procedure dosalloc(var selector : word;
var segment : word; size : longint);
var
res : longint;
begin
res := global_dos_alloc(size);
selector := word(res);
@ -15,13 +16,15 @@ begin
global_dos_free(selector);
end;
type VBEInfoBuf = record
type
VBEInfoBuf = packed record
Signature : array[0..3] of char;
Version : Word;
reserved : array[0..505] of byte;
end;
var selector,
var
selector,
segment : Word;
r : trealregs;
@ -42,11 +45,15 @@ begin
dosmemget(segment, 0, infobuf, sizeof(infobuf));
dosfree(selector);
if (r.ax <> $4f) then begin
Writeln('VBE BIOS extension not available, function call failed');
Writeln('VBE BIOS extension not available, function call ',
'failed');
halt;
end;
if (infobuf.signature[0] = 'V') and (infobuf.signature[1] = 'E') and
(infobuf.signature[2] = 'S') and (infobuf.signature[3] = 'A') then begin
Writeln('VBE version ', hi(infobuf.version), '.', lo(infobuf.version), ' detected');
if (infobuf.signature[0] = 'V') and
(infobuf.signature[1] = 'E') and
(infobuf.signature[2] = 'S') and
(infobuf.signature[3] = 'A') then begin
Writeln('VBE version ', hi(infobuf.version), '.',
lo(infobuf.version), ' detected');
end;
end.

175
docs/go32ex/callback.pas
View File

@ -1,124 +1,126 @@
{ example for :
get_rm_callback()
free_rm_callback()
realintr()
Callbacks
lock_code()
unlock_code()
lock_data()
unlock_data()
trealregs record
tseginfo record
}
{ This program tries to give an example how to install a callback
procedure with the help of the GO32 unit.
{ This program tries to give an example how to install a callback procedure
with the help of the GO32 unit.
It installs a callback which is supplied by any Mircosoft compatible
mouse driver; at a specified mouse action this routine is called. This
callback must provide the services explained in the docs. The main callback
has to be in assembly, because it isn't possible to do these services with
pascal alone. But is written as general as possible to provide maximum
re-usability for other applications and hence it simply calls a normal
pascal user procedure in addition to some initialization and callback
service code, so you don't need to hassle around with it too much.
It installs a callback which is supplied by any Microsoft compatible
mouse driver; at a specified mouse action this routine is called.
This callback must provide the services explained in the docs. The
main callback has to be in assembly, because it isn't possible to do
these services with pascal alone. But is written as general as
possible to provide maximum re-usability for other applications and
hence it simply calls a normal pascal user procedure in addition to
some initialization and callback service code, so you don't need to
hassle around with it too much.
Notes to this user procedure :
*) it should not last too long to execute it
*) ALL data and code touched in this proc MUST be locked BEFORE it is called
the first time
*) ALL data and code touched in this proc MUST be locked BEFORE it is
called the first time
Used software interrupt calls (rough descriptions, only what's used):
Int 33h 0000h - Mircosoft Mouse driver : Reset mouse
Int 33h 0000h - Microsoft Mouse driver : Reset mouse
Input : AX = 0000h
Return : AX = FFFFh if successful
BX = number of buttons (if FFFFh then mouse has 2 buttons)
Int 33h 0001h - Mircosoft Mouse driver : Show mouse cursor
Int 33h 0001h - Microsoft Mouse driver : Show mouse cursor
Input : AX = 0001h
Return : Mouse cursor shown on screen
Int 33h 0002h - Mircosoft mouse driver : Hide mouse cursor
Int 33h 0002h - Microsoft mouse driver : Hide mouse cursor
Input : AX = 0002h
Return : Hides mouse cursor again
Int 33h 000Ch - Mircosoft mouse driver : Install user callback
Int 33h 000Ch - Microsoft mouse driver : Install user callback
Input : AX = 000Ch
CX = bit mask which tells the mouse driver at which actions the
callback should be called, i.e. if button pressed, mouse moved,
...
(In this example it's set to 7Fh so that the callback is called
on every action)
CX = bit mask which tells the mouse driver at which actions
the callback should be called, i.e. if button pressed, mouse
moved etc.
(In this example it's set to 7Fh so that the callback is
called on every action)
ES:EDX = pointer to callback procedure to call
Note : The registers structure supplied to the callback contains valid
mouse data when the handler is called.
Note : The registers structure supplied to the callback contains
valid mouse data when the handler is called.
BX = button state information
CX = mouse X coordinates
DX = mouse Y coordinates
For more detailed information consult any mouse reference or interrupt list.
For more detailed information consult any mouse reference or
interrupt list.
}
{$ASMMODE ATT}
{$MODE FPC}
uses crt, { keypressed(), gotoxy(), wherey(), clrscr() }
uses
crt,
go32;
const mouseint = $33; { the mouse interrupt number }
const
{ the mouse interrupt number }
mouseint = $33;
var mouse_regs : trealregs; { supplied register structure to the callback }
mouse_seginfo : tseginfo; { real mode 48 bit pointer to the callback }
var
{ supplied register structure to the callback }
mouse_regs : trealregs; external name '___v2prt0_rmcb_regs';
{ real mode 48 bit pointer to the callback }
mouse_seginfo : tseginfo;
var mouse_numbuttons : longint;{ number of mouse buttons }
var
{ number of mouse buttons }
mouse_numbuttons : longint;
mouse_action : word; { bit mask for the action which triggered the callback }
mouse_x, mouse_y : Word; { current mouse x and y coordinates }
mouse_b : Word; { button state }
{ bit mask for the action which triggered the callback }
mouse_action : word;
{ current mouse x and y coordinates }
mouse_x, mouse_y : Word;
{ button state }
mouse_b : Word;
userproc_installed : Longbool; { is an additional user procedure installed }
userproc_length : Longint; { length of additional user procedure }
userproc_proc : pointer; { pointer to user proc }
{ is an additional user procedure installed }
userproc_installed : Longbool;
{ length of additional user procedure }
userproc_length : Longint;
{ pointer to user proc }
userproc_proc : pointer;
{ callback control handler, calls a user procedure if installed }
{$ASMMODE DIRECT}
{ callback control handler, calls a user procedure if installed }
procedure callback_handler; assembler;
asm
pushw %es
pushw %ds
pushl %edi
pushl %esi { es:edi is the pointer to real mode regs record }
pushl %eax
movw %es, %ax
movw %ax, %ds
{ give control to user procedure if installed }
cmpl $1, _USERPROC_INSTALLED
je .LNoCallback
cmpl $1, USERPROC_INSTALLED
jne .LNoCallback
pushal
movw %es, %ax { set es = ds, FPC wants this so that some procs work }
movw %ax, %ds
movw U_GO32_DOSMEMSELECTOR, %ax
movw DOSmemSELECTOR, %ax
movw %ax, %fs { set fs for FPC }
call *_USERPROC_PROC
call *USERPROC_PROC
popal
.LNoCallback:
popl %esi
popl %edi
popl %eax
popw %ds
popw %es
pushl %eax
movl (%esi), %eax
movl %eax, %es: 42(%edi) { adjust stack }
addw $4, %es:46(%edi)
popl %eax
iret
end;
{ This dummy is used to obtain the length of the callback control function.
It has to be right after the callback_handler() function.
{ This dummy is used to obtain the length of the callback control
function. It has to be right after the callback_handler() function.
}
procedure mouse_dummy; begin end;
{ This is the supplied user procedure. In this case we simply transform the
virtual 640x200 mouse coordinate system to a 80x25 text mode coordinate
system }
{ This is the supplied user procedure. In this case we simply
transform the virtual 640x200 mouse coordinate system to a 80x25
text mode coordinate system }
procedure textuserproc;
begin
{ the mouse_regs record contains the real mode registers now }
@ -127,8 +129,8 @@ begin
mouse_y := (mouse_regs.dx shr 3) + 1;
end;
{ Description : Installs the mouse callback control handler and handles all
necessary mouse related initialization.
{ Description : Installs the mouse callback control handler and
handles all necessary mouse related initialization.
Input : userproc - pointer to a user procedure, nil if none
userproclen - length of user procedure
}
@ -138,15 +140,18 @@ begin
{ mouse driver reset }
r.eax := $0; realintr(mouseint, r);
if (r.eax <> $FFFF) then begin
Writeln('No Mircosoft compatible mouse found');
Writeln('A Mircosoft compatible mouse driver is necessary to run this example');
Writeln('No Microsoft compatible mouse found');
Writeln('A Microsoft compatible mouse driver is necessary ',
'to run this example');
halt;
end;
{ obtain number of mouse buttons }
if (r.bx = $ffff) then mouse_numbuttons := 2
else mouse_numbuttons := r.bx;
Writeln(mouse_numbuttons, ' button Mircosoft compatible mouse found.');
{ check for additional user procedure, and install it if available }
Writeln(mouse_numbuttons, ' button Microsoft compatible mouse ',
' found.');
{ check for additional user procedure, and install it if
available }
if (userproc <> nil) then begin
userproc_proc := userproc;
userproc_installed := true;
@ -166,15 +171,17 @@ begin
lock_data(mouse_action, sizeof(mouse_action));
lock_data(userproc_installed, sizeof(userproc_installed));
lock_data(@userproc_proc, sizeof(userproc_proc));
lock_data(userproc_proc, sizeof(userproc_proc));
lock_data(mouse_regs, sizeof(mouse_regs));
lock_data(mouse_seginfo, sizeof(mouse_seginfo));
lock_code(@callback_handler, longint(@mouse_dummy)-longint(@callback_handler));
lock_code(@callback_handler,
longint(@mouse_dummy)-longint(@callback_handler));
{ allocate callback (supply registers structure) }
get_rm_callback(@callback_handler, mouse_regs, mouse_seginfo);
{ install callback }
r.eax := $0c; r.ecx := $7f; r.edx := longint(mouse_seginfo.offset);
r.eax := $0c; r.ecx := $7f;
r.edx := longint(mouse_seginfo.offset);
r.es := mouse_seginfo.segment;
realintr(mouseint, r);
{ show mouse cursor }
@ -183,7 +190,8 @@ begin
end;
procedure remove_mouse;
var r : trealregs;
var
r : trealregs;
begin
{ hide mouse cursor }
r.eax := $02; realintr(mouseint, r);
@ -192,7 +200,8 @@ begin
realintr(mouseint, r);
{ free callback }
free_rm_callback(mouse_seginfo);
{ check if additional userproc is installed, and clean up if needed }
{ check if additional userproc is installed, and clean up if
needed }
if (userproc_installed) then begin
unlock_code(userproc_proc, userproc_length);
userproc_proc := nil;
@ -205,12 +214,13 @@ begin
unlock_data(mouse_b, sizeof(mouse_b));
unlock_data(mouse_action, sizeof(mouse_action));
unlock_data(@userproc_proc, sizeof(userproc_proc));
unlock_data(userproc_proc, sizeof(userproc_proc));
unlock_data(userproc_installed, sizeof(userproc_installed));
unlock_data(mouse_regs, sizeof(mouse_regs));
unlock_data(mouse_seginfo, sizeof(mouse_seginfo));
unlock_code(@callback_handler, longint(@mouse_dummy)-longint(@callback_handler));
unlock_code(@callback_handler,
longint(@mouse_dummy)-longint(@callback_handler));
fillchar(mouse_seginfo, sizeof(mouse_seginfo), 0);
end;
@ -221,7 +231,8 @@ begin
while (not keypressed) do begin
{ write mouse state info }
gotoxy(1, wherey);
write('MouseX : ', mouse_x:2, ' MouseY : ', mouse_y:2, ' Buttons : ', mouse_b:2);
write('MouseX : ', mouse_x:2, ' MouseY : ', mouse_y:2,
' Buttons : ', mouse_b:2);
end;
remove_mouse;
end.

74
docs/go32ex/callback.pp
View File

@ -1,14 +1,19 @@
Program callback;
{$ASMMODE ATT}
{$MODE FPC}
uses crt,
uses
crt,
go32;
const mouseint = $33;
const
mouseint = $33;
var mouse_regs : trealregs;
var
mouse_regs : trealregs; external name '___v2prt0_rmcb_regs';
mouse_seginfo : tseginfo;
var mouse_numbuttons : longint;
var
mouse_numbuttons : longint;
mouse_action : word;
mouse_x, mouse_y : Word;
@ -18,35 +23,32 @@ var mouse_numbuttons : longint;
userproc_length : Longint;
userproc_proc : pointer;
{$ASMMODE DIRECT}
procedure callback_handler; assembler;
asm
pushw %es
pushw %ds
pushl %edi
pushl %esi
cmpl $1, _USERPROC_INSTALLED
je .LNoCallback
pushal
pushl %eax
movw %es, %ax
movw %ax, %ds
movw U_GO32_DOSMEMSELECTOR, %ax
cmpl $1, USERPROC_INSTALLED
jne .LNoCallback
pushal
movw DOSmemSELECTOR, %ax
movw %ax, %fs
call *_USERPROC_PROC
call *USERPROC_PROC
popal
.LNoCallback:
popl %esi
popl %edi
popl %eax
popw %ds
popw %es
pushl %eax
movl (%esi), %eax
movl %eax, %es: 42(%edi)
addw $4, %es:46(%edi)
popl %eax
iret
end;
procedure mouse_dummy; begin end;
procedure textuserproc;
@ -56,21 +58,20 @@ begin
mouse_y := (mouse_regs.dx shr 3) + 1;
end;
procedure install_mouse (userproc : pointer;
userproclen : longint);
procedure install_mouse(userproc : pointer; userproclen : longint);
var r : trealregs;
begin
r.eax := $0; realintr(mouseint, r);
if (r.eax <> $FFFF) then begin
Writeln('No Mircosoft compatible mouse found');
Write('A Mircosoft compatible mouse driver is');
writeln(' necessary to run this example');
Writeln('No Microsoft compatible mouse found');
Writeln('A Microsoft compatible mouse driver is necessary ',
'to run this example');
halt;
end;
if (r.bx = $ffff) then mouse_numbuttons := 2
else mouse_numbuttons := r.bx;
Writeln(mouse_numbuttons,
' button Mircosoft compatible mouse found.');
Writeln(mouse_numbuttons, ' button Microsoft compatible mouse ',
' found.');
if (userproc <> nil) then begin
userproc_proc := userproc;
userproc_installed := true;
@ -87,15 +88,15 @@ begin
lock_data(mouse_action, sizeof(mouse_action));
lock_data(userproc_installed, sizeof(userproc_installed));
lock_data(@userproc_proc, sizeof(userproc_proc));
lock_data(userproc_proc, sizeof(userproc_proc));
lock_data(mouse_regs, sizeof(mouse_regs));
lock_data(mouse_seginfo, sizeof(mouse_seginfo));
lock_code(@callback_handler,
longint(@mouse_dummy)
- longint(@callback_handler));
longint(@mouse_dummy)-longint(@callback_handler));
get_rm_callback(@callback_handler, mouse_regs, mouse_seginfo);
r.eax := $0c; r.ecx := $7f; r.edx := longint(mouse_seginfo.offset);
r.eax := $0c; r.ecx := $7f;
r.edx := longint(mouse_seginfo.offset);
r.es := mouse_seginfo.segment;
realintr(mouseint, r);
r.eax := $01;
@ -103,7 +104,8 @@ begin
end;
procedure remove_mouse;
var r : trealregs;
var
r : trealregs;
begin
r.eax := $02; realintr(mouseint, r);
r.eax := $0c; r.ecx := 0; r.edx := 0; r.es := 0;
@ -120,15 +122,13 @@ begin
unlock_data(mouse_b, sizeof(mouse_b));
unlock_data(mouse_action, sizeof(mouse_action));
unlock_data(@userproc_proc, sizeof(userproc_proc));
unlock_data(userproc_installed,
sizeof(userproc_installed));
unlock_data(userproc_proc, sizeof(userproc_proc));
unlock_data(userproc_installed, sizeof(userproc_installed));
unlock_data(mouse_regs, sizeof(mouse_regs));
unlock_data(mouse_seginfo, sizeof(mouse_seginfo));
unlock_code(@callback_handler,
longint(@mouse_dummy)
- longint(@callback_handler));
longint(@mouse_dummy)-longint(@callback_handler));
fillchar(mouse_seginfo, sizeof(mouse_seginfo), 0);
end;
@ -137,10 +137,8 @@ begin
install_mouse(@textuserproc, 400);
Writeln('Press any key to exit...');
while (not keypressed) do begin
{ write mouse state info }
gotoxy(1, wherey);
write('MouseX : ', mouse_x:2,
' MouseY : ', mouse_y:2,
write('MouseX : ', mouse_x:2, ' MouseY : ', mouse_y:2,
' Buttons : ', mouse_b:2);
end;
remove_mouse;

21
docs/go32ex/flags.pas
View File

@ -1,12 +1,8 @@
{ example for :
realintr()
flags constants
trealregs record
}
{ This example demonstrates the use of the flag constants in conjunction with
an interrupt call
{ This example demonstrates the use of the flag constants in
conjunction with an interrupt call
In detail it checks if APM (advanced power management) is available.
In detail it checks if APM (advanced power management) is
available.
Int 15h 5300h - APM specification : Installation check
Input : AX = 5300h
@ -16,9 +12,11 @@
AL = minor version (BCD)
}
uses go32;
uses
go32;
var r : trealregs;
var
r : trealregs;
begin
{ set register values and issue real mode interrupt call }
@ -27,7 +25,8 @@ begin
realintr($15, r);
{ check if carry clear and write a suited message }
if ((r.flags and carryflag)=0) then begin
Writeln('APM v', (r.ah and $f), '.', (r.al shr 4), (r.al and $f), ' detected');
Writeln('APM v', (r.ah and $f), '.',
(r.al shr 4), (r.al and $f), ' detected');
end else
Writeln('APM not present');
end.

14
docs/go32ex/flags.pp
View File

@ -1,18 +1,16 @@
Program flags;
uses
go32;
uses go32;
var r : trealregs;
var
r : trealregs;
begin
r.ax := $5300;
r.bx := 0;
realintr($15, r);
{ check if carry clear and write a suited message }
if ((r.flags and carryflag)=0) then begin
Writeln('APM v',(r.ah and $f),
'.', (r.al shr 4), (r.al and $f),
' detected');
Writeln('APM v', (r.ah and $f), '.',
(r.al shr 4), (r.al and $f), ' detected');
end else
Writeln('APM not present');
end.

30
docs/go32ex/getrunmd.pas
View File

@ -1,19 +1,25 @@
{ example program for
get_run_mode() + constants
}
{ Simply write a message according to the current environment }
uses go32;
uses
go32;
begin
{ depending on the detected environment we simply write another message
}
{ depending on the detected environment we simply write
another message Note: in go32v2 this will always be rm_dpmi. }
case (get_run_mode) of
rm_unknown : Writeln('Unknown environment found');
rm_raw : Writeln('You are currently running in raw mode (without HIMEM)');
rm_xms : Writeln('You are currently using HIMEM.SYS only');
rm_vcpi : Writeln('VCPI server detected. You''re using HIMEM and EMM386');
rm_dpmi : Writeln('DPMI detected. You''re using a DPMI host like a windows DOS box or CWSDPMI');
rm_unknown :
Writeln('Unknown environment found');
rm_raw :
Writeln('You are currently running in raw mode ',
'(without HIMEM)');
rm_xms :
Writeln('You are currently using HIMEM.SYS only');
rm_vcpi :
Writeln('VCPI server detected. You''re using HIMEM and ',
'EMM386');
rm_dpmi :
Writeln('DPMI detected. You''re using a DPMI host like ',
'a windows DOS box or CWSDPMI');
end;
end.

16
docs/go32ex/getrunmd.pp
View File

@ -1,12 +1,7 @@
Program getrunmd;
uses go32;
uses
go32;
begin
{
depending on the detected environment,
we simply write another message
}
case (get_run_mode) of
rm_unknown :
Writeln('Unknown environment found');
@ -16,11 +11,10 @@ case (get_run_mode) of
rm_xms :
Writeln('You are currently using HIMEM.SYS only');
rm_vcpi :
Writeln('VCPI server detected.',
' You''re using HIMEM and EMM386');
Writeln('VCPI server detected. You''re using HIMEM and ',
'EMM386');
rm_dpmi :
Writeln('DPMI detected.',
' You''re using a DPMI host like ',
Writeln('DPMI detected. You''re using a DPMI host like ',
'a windows DOS box or CWSDPMI');
end;
end.

68
docs/go32ex/intpm.pas Normal file
View File

@ -0,0 +1,68 @@
{ This example shows how to redirect a software interrupt by
changing the protected mode handler of the DPMI host.
In more detail it hooks interrupt 1Ch which is called every
time the timer interrupt (int 08) is executed. This is the
preferred way to hook the timer, because int 1Ch is a software
interrupt which doesn't need so much initialization stuff
compared to hooking a hardware interrupt.
}
uses
crt,
go32;
const
{ interrupt number we want to hook }
int1c = $1c;
var
{ 48 bit pointer to old interrupt handler }
oldint1c : tseginfo;
{ 48 bit pointer to new interrupt handler }
newint1c : tseginfo;
{ increased every time the interrupt is called }
int1c_counter : Longint;
{ the current data selector }
int1c_ds : Word; external name '___v2prt0_ds_alias';
{ the actual handler code }
procedure int1c_handler; assembler;
asm
cli
{ save all registers }
pushw %ds
pushw %ax
{ prepare segment registers for FPC procedure }
movw %cs:int1c_ds, %ax
movw %ax, %ds
{ simply increase the counter by one }
incl int1c_counter
{ restore registers }
popw %ax
popw %ds
sti
iret
end;
var i : Longint;
begin
{ insert right handler data into new handler variable }
newint1c.offset := @int1c_handler;
newint1c.segment := get_cs;
{ get the old handler }
get_pm_interrupt(int1c, oldint1c);
Writeln('-- Press any key to exit --');
{ set new handler }
set_pm_interrupt(int1c, newint1c);
{ write the number of interrupts occured }
while (not keypressed) do begin
gotoxy(1, wherey);
write('Number of interrupts occured : ', int1c_counter);
end;
{ restore old handler }
set_pm_interrupt(int1c, oldint1c);
end.

28
docs/go32ex/intpm.pp
View File

@ -1,27 +1,30 @@
Program int_pm;
uses
crt,
go32;
uses crt, go32;
const
int1c = $1c;
const int1c = $1c;
var oldint1c : tseginfo;
var
oldint1c : tseginfo;
newint1c : tseginfo;
int1c_counter : Longint;
{$ASMMODE DIRECT}
int1c_ds : Word; external name '___v2prt0_ds_alias';
procedure int1c_handler; assembler;
asm
cli
pushw %ds
pushw %ax
movw %cs:INT1C_DS, %ax
movw %cs:int1c_ds, %ax
movw %ax, %ds
incl _INT1C_COUNTER
incl int1c_counter
popw %ax
popw %ds
sti
iret
INT1C_DS: .word 0
end;
var i : Longint;
@ -30,16 +33,11 @@ begin
newint1c.offset := @int1c_handler;
newint1c.segment := get_cs;
get_pm_interrupt(int1c, oldint1c);
asm
movw %ds, %ax
movw %ax, INT1C_DS
end;
Writeln('-- Press any key to exit --');
set_pm_interrupt(int1c, newint1c);
while (not keypressed) do begin
gotoxy(1, wherey);
write('Number of interrupts occured : ',
int1c_counter);
write('Number of interrupts occured : ', int1c_counter);
end;
set_pm_interrupt(int1c, oldint1c);
end.

101
docs/go32ex/keyclick.pas
View File

@ -1,59 +1,64 @@
{ example for : Interrupt redirection (Hardware interrupts)
set_pm_interrupt()
get_pm_interrupt()
lock_code()
lock_data()
unlock_code()
unlock_data()
tseginfo record
}
{ This example demonstrates how to chain to a hardware interrupt.
In more detail, it hooks the keyboard interrupt, calls a user procedure
which in this case simply turns the PC speaker on and off. Then the old
interrupt is called.
In more detail, it hooks the keyboard interrupt, calls a user
procedure which in this case simply turns the PC speaker on and off.
Then the old interrupt is called.
}
uses crt, { readkey() }
{$ASMMODE ATT}
{$MODE FPC}
uses
crt,
go32;
const kbdint = $9; { keyboard is IRQ 1 -> interrupt 9 }
const
{ keyboard is IRQ 1 -> interrupt 9 }
kbdint = $9;
var oldint9_handler : tseginfo; { holds old PM interrupt handler address }
newint9_handler : tseginfo; { new PM interrupt handler }
var
{ holds old PM interrupt handler address }
oldint9_handler : tseginfo;
{ new PM interrupt handler }
newint9_handler : tseginfo;
clickproc : pointer; { pointer to interrupt handler }
{ pointer to interrupt handler }
clickproc : pointer;
{ the data segment selector }
backupDS : Word; external name '___v2prt0_ds_alias';
{$ASMMODE DIRECT}
{ interrupt handler }
procedure int9_handler; assembler;
asm
cli
{ save all registers, because we don't know which the compiler uses for
the called procedure }
{ save all registers, because we don't know which the compiler
uses for the called procedure }
pushl %ds
pushl %es
pushl %fs
pushl %gs
pushal
{ set up to call a FPC procedure }
movw %cs:INT9_DS, %ax
movw %cs:backupDS, %ax
movw %ax, %ds
movw %ax, %es
movw U_GO32_DOSMEMSELECTOR, %ax
movw dosmemselector, %ax
movw %ax, %fs
{ call user procedure }
call *_CLICKPROC
call *clickproc
{ restore all registers }
popal
ljmp %cs:OLDHANDLER { call old handler }
{ we don't need to do anything more, because the old interrupt handler
does this for us (send EOI command, iret, sti...) }
INT9_DS: .word 0
OLDHANDLER:
.long 0
.word 0
popl %gs
popl %fs
popl %es
popl %ds
{ note: in go32v2 mode %cs=%ds=%es !!!}
ljmp %cs:oldint9_handler { call old handler }
{ we don't need to do anything more, because the old interrupt
handler does this for us (send EOI command, iret, sti...) }
end;
{ dummy procedure to retrieve exact length of handler, for locking and
unlocking functions }
{ dummy procedure to retrieve exact length of handler, for locking
and unlocking functions }
procedure int9_dummy; begin end;
{ demo user procedure, simply clicks on every keypress }
@ -61,8 +66,8 @@ procedure clicker;
begin
sound(500); delay(10); nosound;
end;
{ dummy procedure to retrieve exact length of user procedure for locking and
unlocking functions }
{ dummy procedure to retrieve exact length of user procedure for
locking and unlocking functions }
procedure clicker_dummy; begin end;
{ installs our new handler }
@ -73,22 +78,15 @@ begin
lock_data(clickproc, sizeof(clickproc));
lock_data(dosmemselector, sizeof(dosmemselector));
lock_code(@clicker, longint(@clicker_dummy)-longint(@clicker));
lock_code(@int9_handler, longint(@int9_dummy)-longint(@int9_handler));
lock_code(@clicker,
longint(@clicker_dummy) - longint(@clicker));
lock_code(@int9_handler,
longint(@int9_dummy)-longint(@int9_handler));
{ fill in new handler's 48 bit pointer }
newint9_handler.offset := @int9_handler;
newint9_handler.segment := get_cs;
{ get old PM interrupt handler }
get_pm_interrupt(kbdint, oldint9_handler);
{ store old PM interrupt handlers address in interrupt handler }
asm
movw %ds, %ax
movw %ax, INT9_DS
movl _OLDINT9_HANDLER, %eax
movl %eax, OLDHANDLER
movw 4+_OLDINT9_HANDLER, %ax
movw %ax, 4+OLDHANDLER
end;
{ set the new interrupt handler }
set_pm_interrupt(kbdint, newint9_handler);
end;
@ -102,11 +100,14 @@ begin
unlock_data(dosmemselector, sizeof(dosmemselector));
unlock_data(clickproc, sizeof(clickproc));
unlock_code(@clicker, longint(@clicker_dummy)-longint(@clicker));
unlock_code(@int9_handler, longint(@int9_dummy)-longint(@int9_handler));
unlock_code(@clicker,
longint(@clicker_dummy)-longint(@clicker));
unlock_code(@int9_handler,
longint(@int9_dummy)-longint(@int9_handler));
end;
var ch : char;
var
ch : char;
begin
install_click;

62
docs/go32ex/keyclick.pp
View File

@ -1,43 +1,47 @@
Program Keyclick;
{$ASMMODE ATT}
{$MODE FPC}
uses crt,
uses
crt,
go32;
const kbdint = $9;
const
kbdint = $9;
var oldint9_handler : tseginfo;
var
oldint9_handler : tseginfo;
newint9_handler : tseginfo;
clickproc : pointer;
backupDS : Word; external name '___v2prt0_ds_alias';
{$ASMMODE DIRECT}
procedure int9_handler; assembler;
asm
cli
pushl %ds
pushl %es
pushl %fs
pushl %gs
pushal
movw %cs:INT9_DS, %ax
movw %cs:backupDS, %ax
movw %ax, %ds
movw %ax, %es
movw U_GO32_DOSMEMSELECTOR, %ax
movw dosmemselector, %ax
movw %ax, %fs
call *_CLICKPROC
call *clickproc
popal
ljmp %cs:OLDHANDLER
INT9_DS: .word 0
OLDHANDLER:
.long 0
.word 0
popl %gs
popl %fs
popl %es
popl %ds
ljmp %cs:oldint9_handler
end;
procedure int9_dummy; begin end;
procedure clicker;
begin
sound(500); delay(10); nosound;
end;
procedure clicker_dummy; begin end;
procedure install_click;
@ -49,19 +53,10 @@ begin
lock_code(@clicker,
longint(@clicker_dummy) - longint(@clicker));
lock_code(@int9_handler,
longint(@int9_dummy)
- longint(@int9_handler));
longint(@int9_dummy)-longint(@int9_handler));
newint9_handler.offset := @int9_handler;
newint9_handler.segment := get_cs;
get_pm_interrupt(kbdint, oldint9_handler);
asm
movw %ds, %ax
movw %ax, INT9_DS
movl _OLDINT9_HANDLER, %eax
movl %eax, OLDHANDLER
movw 4+_OLDINT9_HANDLER, %ax
movw %ax, 4+OLDHANDLER
end;
set_pm_interrupt(kbdint, newint9_handler);
end;
@ -70,20 +65,19 @@ begin
set_pm_interrupt(kbdint, oldint9_handler);
unlock_data(dosmemselector, sizeof(dosmemselector));
unlock_data(clickproc, sizeof(clickproc));
unlock_code(@clicker,
longint(@clicker_dummy)
- longint(@clicker));
longint(@clicker_dummy)-longint(@clicker));
unlock_code(@int9_handler,
longint(@int9_dummy)
- longint(@int9_handler));
longint(@int9_dummy)-longint(@int9_handler));
end;
var ch : char;
var
ch : char;
begin
install_click;
Writeln('Enter any message.',
' Press return when finished');
Writeln('Enter any message. Press return when finished');
while (ch <> #13) do begin
ch := readkey; write(ch);
end;

42
docs/go32ex/meminfo.pas
View File

@ -1,18 +1,13 @@
{ example for
tmeminfo record
int31error var
get_meminfo()
get_page_size()
}
{ Shows how to obtain memory information via get_meminfo();
notice the checks if any of the returned information is invalid (-1)
}
uses go32;
uses
go32;
var meminfo : tmeminfo;
var
meminfo : tmeminfo;
begin
get_meminfo(meminfo);
@ -21,23 +16,34 @@ begin
Writeln('DPMI error number : ', int31error);
end else begin
with meminfo do begin
Writeln('Largest available free block : ', available_memory div 1024, ' kbytes');
Writeln('Largest available free block : ',
available_memory div 1024, ' kbytes');
if (available_pages <> -1) then
Writeln('Maximum available unlocked pages : ', available_pages);
Writeln('Maximum available unlocked pages : ',
available_pages);
if (available_lockable_pages <> -1) then
Writeln('Maximum lockable available pages : ', available_lockable_pages);
Writeln('Maximum lockable available pages : ',
available_lockable_pages);
if (linear_space <> -1) then
Writeln('Linear address space size : ', linear_space*get_page_size div 1024, ' kbytes');
Writeln('Linear address space size : ',
linear_space*get_page_size div 1024, ' kbytes');
if (unlocked_pages <> -1) then
Writeln('Total number of unlocked pages : ', unlocked_pages);
Writeln('Total number of unlocked pages : ',
unlocked_pages);
if (available_physical_pages <> -1) then
Writeln('Total number of free pages : ', available_physical_pages);
Writeln('Total number of free pages : ',
available_physical_pages);
if (total_physical_pages <> -1) then
Writeln('Total number of physical pages : ', total_physical_pages);
Writeln('Total number of physical pages : ',
total_physical_pages);
if (free_linear_space <> -1) then
Writeln('Free linear address space : ', free_linear_space*get_page_size div 1024, ' kbytes');
Writeln('Free linear address space : ',
free_linear_space*get_page_size div 1024,
' kbytes');
if (max_pages_in_paging_file <> -1) then
Writeln('Maximum size of paging file : ', max_pages_in_paging_file*get_page_size div 1024, ' kbytes');
Writeln('Maximum size of paging file : ',
max_pages_in_paging_file*get_page_size div 1024,
' kbytes');
end;
end;
end.

21
docs/go32ex/meminfo.pp
View File

@ -1,19 +1,16 @@
Program meminf;
uses
go32;
uses go32;
var meminfo : tmeminfo;
var
meminfo : tmeminfo;
begin
get_meminfo(meminfo);
if (int31error <> 0) then
begin
if (int31error <> 0) then begin
Writeln('Error getting DPMI memory information... Halting');
Writeln('DPMI error number : ', int31error);
end
else
with meminfo do
begin
end else begin
with meminfo do begin
Writeln('Largest available free block : ',
available_memory div 1024, ' kbytes');
if (available_pages <> -1) then
@ -24,8 +21,7 @@ else
available_lockable_pages);
if (linear_space <> -1) then
Writeln('Linear address space size : ',
linear_space*get_page_size div 1024,
' kbytes');
linear_space*get_page_size div 1024, ' kbytes');
if (unlocked_pages <> -1) then
Writeln('Total number of unlocked pages : ',
unlocked_pages);
@ -44,4 +40,5 @@ else
max_pages_in_paging_file*get_page_size div 1024,
' kbytes');
end;
end;
end.

9
docs/go32ex/outport.pas
View File

@ -1,12 +1,9 @@
{ example for : outport*()
I/O access
}
{ This example demonstrates the use of the outport functions.
It simply turns the PC's internal speaker on for 50 ms and off again.
It simply turns the PC's internal speaker on for 50 ms and off again
}
uses crt,
uses
crt,
go32;
begin

9
docs/go32ex/outport.pp
View File

@ -1,12 +1,9 @@
program outport;
uses crt, go32;
uses
crt,
go32;
begin
{ turn on speaker }
outportb($61, $ff);
{ wait a little bit }
delay(50);
{ turn it off again }
outportb($61, $0);
end.

102
docs/go32ex/rmpmint.pas Normal file
View File

@ -0,0 +1,102 @@
{ This example shows the difference between protected and real mode
interrupts; it redirects the protected mode handler to an own handler
which returns an impossible function result and calls it afterwards.
Then the real mode handler is called directly, to show the difference
between the two.
Used Interrupt:
get DOS version Int 21h / function 30h
Input: AH = $30
AL = $1
Return: AL = major version number
AH = minor version number
}
uses
crt,
go32;
var
r : trealregs;
{ temporary variable used for the protected mode int call }
axreg : Word;
oldint21h : tseginfo;
newint21h : tseginfo;
{ this is our int 21h protected mode interupt handler. It catches
the function call to get the DOS version, all other int 21h calls
are redirected to the old handler; it is written in assembly
because the old handler can't be called with pascal }
procedure int21h_handler; assembler;
asm
cmpw $0x3001, %ax
jne .LCallOld
movw $0x3112, %ax
iret
.LCallOld:
ljmp %cs:oldint21h
end;
{ a small helper procedure, which waits for a keypress }
procedure resume;
begin
Writeln;
Write('-- press any key to resume --'); readkey;
gotoxy(1, wherey); clreol;
end;
begin
{ see the text messages for further detail }
clrscr;
Writeln('Executing real mode interrupt');
resume;
r.ah := $30; r.al := $01; realintr($21, r);
Writeln('DOS v', r.al,'.',r.ah, ' detected');
resume;
Writeln('Executing protected mode interrupt without our own',
' handler');
Writeln;
asm
movb $0x30, %ah
movb $0x01, %al
int $0x21
movw %ax, axreg
end;
Writeln('DOS v', r.al,'.',r.ah, ' detected');
resume;
Writeln('As you can see the DPMI hosts default protected mode',
'handler');
Writeln('simply redirects it to the real mode handler');
resume;
Writeln('Now exchanging the protected mode interrupt with our ',
'own handler');
resume;
newint21h.offset := @int21h_handler;
newint21h.segment := get_cs;
get_pm_interrupt($21, oldint21h);
set_pm_interrupt($21, newint21h);
Writeln('Executing real mode interrupt again');
resume;
r.ah := $30; r.al := $01; realintr($21, r);
Writeln('DOS v', r.al,'.',r.ah, ' detected');
Writeln;
Writeln('See, it didn''t change in any way.');
resume;
Writeln('Now calling protected mode interrupt');
resume;
asm
movb $0x30, %ah
movb $0x01, %al
int $0x21
movw %ax, axreg
end;
Writeln('DOS v', lo(axreg),'.',hi(axreg), ' detected');
Writeln;
Writeln('Now you can see that there''s a distinction between ',
'the two ways of calling interrupts...');
set_pm_interrupt($21, oldint21h);
end.

48
docs/go32ex/rmpmint.pp
View File

@ -1,27 +1,22 @@
Program rmpm_int;
uses
crt,
go32;
uses crt, go32;
{$ASMMODE DIRECT}
var r : trealregs;
var
r : trealregs;
axreg : Word;
oldint21h : tseginfo;
newint21h : tseginfo;
procedure int21h_handler; assembler;
asm
cmpw $0x3001, %ax
jne CallOld
jne .LCallOld
movw $0x3112, %ax
iret
CallOld:
ljmp %cs:OLDHANDLER
OLDHANDLER: .long 0
.word 0
.LCallOld:
ljmp %cs:oldint21h
end;
procedure resume;
@ -38,34 +33,28 @@ begin
r.ah := $30; r.al := $01; realintr($21, r);
Writeln('DOS v', r.al,'.',r.ah, ' detected');
resume;
Writeln('Executing protected mode interrupt',
' without our own handler');
Writeln('Executing protected mode interrupt without our own',
' handler');
Writeln;
asm
movb $0x30, %ah
movb $0x01, %al
int $0x21
movw %ax, _AXREG
movw %ax, axreg
end;
Writeln('DOS v', r.al,'.',r.ah, ' detected');
resume;
Writeln('As you can see the DPMI hosts',
' default protected mode handler');
Writeln('As you can see the DPMI hosts default protected mode',
'handler');
Writeln('simply redirects it to the real mode handler');
resume;
Writeln('Now exchanging the protected mode',
'interrupt with our own handler');
Writeln('Now exchanging the protected mode interrupt with our ',
'own handler');
resume;
newint21h.offset := @int21h_handler;
newint21h.segment := get_cs;
get_pm_interrupt($21, oldint21h);
asm
movl _OLDINT21H, %eax
movl %eax, OLDHANDLER
movw 4+_OLDINT21H, %ax
movw %ax, 4+OLDHANDLER
end;
set_pm_interrupt($21, newint21h);
Writeln('Executing real mode interrupt again');
@ -81,12 +70,11 @@ begin
movb $0x30, %ah
movb $0x01, %al
int $0x21
movw %ax, _AXREG
movw %ax, axreg
end;
Writeln('DOS v', lo(axreg),'.',hi(axreg), ' detected');
Writeln;
Writeln('Now you can see that there''s',
' a distinction between the two ways of ');
Writeln('calling interrupts...');
Writeln('Now you can see that there''s a distinction between ',
'the two ways of calling interrupts...');
set_pm_interrupt($21, oldint21h);
end.

150
docs/go32ex/seldes.pas Normal file
View File

@ -0,0 +1,150 @@
{
This example demonstrates the usage of descriptors and the effects of
changing its limit and base address.
In more detail, the program fills the region described by an
allocated descriptor in text screen memory with various characters.
Before doing this it saves the entire screen contents to the heap and
restores it afterwards.
Some additional background:
The text screen of a VGA card has it's address space at $B800:0;
screen memory is organized in a linear fashion, e.g. the second line
comes directly after the first, where each cell occupies 2 bytes of
memory (1 byte character data, 1 byte attributes). It is 32 kb in
size.
Hence the offset of a single memory cell from its origin is:
Y * columns * 2 + X * 2
where X and Y mark the point and columns is the number of character
cells per line
}
{$mode delphi}
uses
crt,
go32;
const
{ screen x and y dimensions }
maxx = 80;
maxy = 25;
{ bytes used for every character cell }
bytespercell = 2;
{ screen size in bytes }
screensize = maxx * maxy * bytespercell;
{ the linear address of $B800:0 }
linB8000 = $B800 * 16;
type
string80 = string[80];
var
{ holds the old screen contents }
text_save : array[0..screensize-1] of byte;
{ old cursor x and y coordinates }
text_oldx, text_oldy : Word;
{ selector to the text mode screen }
text_sel : Word;
{ prints a status message on the first line of the screen and then
waits for a keypress }
procedure status(s : string80);
begin
gotoxy(1, 1); clreol; write(s); readkey;
end;
{ writes some descriptor info on the last 2 lines }
procedure selinfo(sel : Word);
begin
gotoxy(1, 24);
clreol; writeln('Descriptor base address : $',
hexstr(get_segment_base_address(sel), 8));
clreol; write('Descriptor limit : ', get_segment_limit(sel));
end;
{ returns a 2 byte character cell, which includes character data
and its color attributes }
function makechar(ch : char; color : byte) : Word;
begin
result := byte(ch) or (color shl 8);
end;
begin
{ save original screen contents to variable, this time by using
seg_move() and the dosmemselector variable }
seg_move(dosmemselector, linB8000, get_ds, longint(@text_save),
screensize);
{ additionally we have to save the old screen cursor
coordinates }
text_oldx := wherex; text_oldy := wherey;
{ clear the whole screen }
seg_fillword(dosmemselector, linB8000, screensize div 2,
makechar(' ', Black or (Black shl 4)));
{ output message }
status('Creating selector ''text_sel'' to a part of ' +
'text screen memory');
{ allocate descriptor }
text_sel := allocate_ldt_descriptors(1);
{ set its base address to the linear address of the text screen
+ the byte size of one line (=maxx * bytespercell * 1) }
set_segment_base_address(text_sel,
linB8000 + bytespercell * maxx * 1);
{ the limit is set to the screensize reduced by one (a must be)
and the number of lines we don't want to have touched (first
line + lower 2 lines) }
set_segment_limit(text_sel, screensize - 1 - bytespercell *
maxx * 3);
{ write descriptor info }
selinfo(text_sel);
status('and clearing entire memory selected by ''text_sel''' +
' descriptor');
{ fill the entire selected memory with single characters }
seg_fillword(text_sel, 0, (get_segment_limit(text_sel)+1) div 2,
makechar(' ', LightBlue shl 4));
status('Notice that only the memory described by the ' +
'descriptor changed, nothing else');
status('Now reducing it''s limit and base and setting it''s ' +
'described memory');
{ set the base address of the descriptor (increase it by the
byte size of one line) }
set_segment_base_address(text_sel,
get_segment_base_address(text_sel) + bytespercell * maxx);
{ decrease the limit by byte size of 2 lines (1 line because
base address changed, one line on the lower end) }
set_segment_limit(text_sel,
get_segment_limit(text_sel) - bytespercell * maxx * 2);
{ write descriptor info }
selinfo(text_sel);
status('Notice that the base addr increased by one line but ' +
'the limit decreased by 2 lines');
status('This should give you the hint that the limit is ' +
'relative to the base');
{ fill the descriptor area }
seg_fillword(text_sel, 0, (get_segment_limit(text_sel)+1) div 2,
makechar(#176, LightMagenta or Brown shl 4));
status('Now let''s get crazy and copy 10 lines of data from ' +
'the previously saved screen');
{ copy memory from the data segment to screen }
seg_move(get_ds, longint(@text_save), text_sel,
maxx * bytespercell * 2, maxx * bytespercell * 10);
status('At last freeing the descriptor and restoring the old ' +
' screen contents..');
status('I hope this little program may give you some hints ' +
'on working with descriptors');
{ free the descriptor so that it can be used for things }
free_ldt_descriptor(text_sel);
{ restore old state }
seg_move(get_ds, longint(@text_save), dosmemselector,
linB8000, screensize);
gotoxy(text_oldx, text_oldy);
end.

96
docs/go32ex/seldes.pp
View File

@ -1,16 +1,18 @@
Program sel_des;
uses crt,
{$mode delphi}
uses
crt,
go32;
const maxx = 80;
const
maxx = 80;
maxy = 25;
bytespercell = 2;
screensize = maxx * maxy * bytespercell;
linB8000 = $B800 * 16;
type string80 = string[80];
type
string80 = string[80];
var
text_save : array[0..screensize-1] of byte;
@ -20,21 +22,15 @@ var
procedure status(s : string80);
begin
gotoxy(1, 1);
clreol;
write(s);
readkey;
gotoxy(1, 1); clreol; write(s); readkey;
end;
procedure selinfo(sel : Word);
begin
gotoxy(1, 24);
clreol;
writeln('Descriptor base address : $',
clreol; writeln('Descriptor base address : $',
hexstr(get_segment_base_address(sel), 8));
clreol;
write('Descriptor limit : ',
get_segment_limit(sel));
clreol; write('Descriptor limit : ', get_segment_limit(sel));
end;
function makechar(ch : char; color : byte) : Word;
@ -43,59 +39,53 @@ begin
end;
begin
seg_move(dosmemselector, linB8000,
get_ds, longint(@text_save), screensize);
seg_move(dosmemselector, linB8000, get_ds, longint(@text_save),
screensize);
text_oldx := wherex; text_oldy := wherey;
seg_fillword(dosmemselector, linB8000,
screensize div 2,
seg_fillword(dosmemselector, linB8000, screensize div 2,
makechar(' ', Black or (Black shl 4)));
status('Creating selector ' +
'''text_sel'' to a part of text screen memory');
status('Creating selector ''text_sel'' to a part of ' +
'text screen memory');
text_sel := allocate_ldt_descriptors(1);
set_segment_base_address(text_sel, linB8000
+ bytespercell * maxx * 1);
set_segment_limit(text_sel,
screensize-1-bytespercell*maxx*3);
set_segment_base_address(text_sel,
linB8000 + bytespercell * maxx * 1);
set_segment_limit(text_sel, screensize - 1 - bytespercell *
maxx * 3);
selinfo(text_sel);
status('and clearing entire memory ' +
'selected by ''text_sel'' descriptor');
seg_fillword(text_sel, 0,
(get_segment_limit(text_sel)+1) div 2,
status('and clearing entire memory selected by ''text_sel''' +
' descriptor');
seg_fillword(text_sel, 0, (get_segment_limit(text_sel)+1) div 2,
makechar(' ', LightBlue shl 4));
status('Notice that only the memory described'+
' by the descriptor changed, nothing else');
status('Notice that only the memory described by the' +
' descriptor changed, nothing else');
status('Now reducing it''s limit and base and '+
'setting it''s described memory');
status('Now reducing it''s limit and base and setting it''s ' +
'described memory');
set_segment_base_address(text_sel,
get_segment_base_address(text_sel)
+ bytespercell * maxx);
get_segment_base_address(text_sel) + bytespercell * maxx);
set_segment_limit(text_sel,
get_segment_limit(text_sel)
- bytespercell * maxx * 2);
get_segment_limit(text_sel) - bytespercell * maxx * 2);
selinfo(text_sel);
status('Notice that the base addr increased by '+
'one line but the limit decreased by 2 lines');
status('This should give you the hint that the '+
'limit is relative to the base');
seg_fillword(text_sel, 0,
(get_segment_limit(text_sel)+1) div 2,
status('Notice that the base addr increased by one line but ' +
'the limit decreased by 2 lines');
status('This should give you the hint that the limit is ' +
'relative to the base');
seg_fillword(text_sel, 0, (get_segment_limit(text_sel)+1) div 2,
makechar(#176, LightMagenta or Brown shl 4));
status('Now let''s get crazy and copy 10 lines'+
' of data from the previously saved screen');
seg_move(get_ds, longint(@text_save),
text_sel, maxx * bytespercell * 2,
maxx * bytespercell * 10);
status('Now let''s get crazy and copy 10 lines of data from ' +
'the previously saved screen');
seg_move(get_ds, longint(@text_save), text_sel,
maxx * bytespercell * 2, maxx * bytespercell * 10);
status('At last freeing the descriptor and '+
'restoring the old screen contents..');
status('I hope this little program may give '+
'you some hints on working with descriptors');
status('At last freeing the descriptor and restoring the old '+
' screen contents..');
status('I hope this little program may give you some hints on '+
'working with descriptors');
free_ldt_descriptor(text_sel);
seg_move(get_ds, longint(@text_save),
dosmemselector, linB8000, screensize);
seg_move(get_ds, longint(@text_save), dosmemselector,
linB8000, screensize);
gotoxy(text_oldx, text_oldy);
end.

26
docs/go32ex/softint.pas
View File

@ -1,33 +1,23 @@
{ example program to call
software interrupts
realintr()
trealregs type
}
{ Executes a real mode software interrupt
Exactly the interrupt call to get the DOS version.
get DOS version Int 21h / function 30h
Input: AH = $30
Input:
AH = $30
AL = $1
Return: AL = major version number
Return:
AL = major version number
AH = minor version number
}
uses go32; { realintr, trealregs }
uses
go32;
var r : trealregs;
var
r : trealregs;
begin
{ get DOS version Int 21h / function 30h
Input: AH = $30
AL = $1
Return: AL = major version number
AH = minor version number
}
r.ah := $30;
r.al := $01;
realintr($21, r);

9
docs/go32ex/softint.pp
View File

@ -1,10 +1,11 @@
Program softint;
uses
go32;
uses go32;
var r : trealregs;
var
r : trealregs;
begin
r.ah := $30;
r.al := $01;
realintr($21, r);
Writeln('DOS v', r.al,'.',r.ah, ' detected');

71
docs/go32ex/textmess.pas
View File

@ -1,45 +1,48 @@
{ Example for : dosmemmove()
dosmemfillchar()
dosmemget()
DOS memory access
}
{ This example copies around some blocks of memory in DOS memory space.
{ This example copies around some blocks of memory in DOS memory
space.
In more detail, the program copies a string randomly to the text mode
screen. Aditionally it messes around a bit with the color attributes of
the string.
Before doing this it saves the entire screen contents to the heap and
restores it afterwards.
In more detail, the program copies a string randomly to the text
mode screen. Aditionally it messes around a bit with the color
attributes of the string.
Before doing this it saves the entire screen contents to the heap
and restores it afterwards.
Some additional background:
The text screen of a VGA card has it's address space at $B800:0; screen
memory is organized in a linear fashion, e.g. the second line comes
directly after the first, where each cell occupies 2 bytes of memory
(1 byte character data, 1 byte attributes). It is 32 kb in size.
The text screen of a VGA card has it's address space at $B800:0;
screen memory is organized in a linear fashion, e.g. the second line
comes directly after the first, where each cell occupies 2 bytes of
memory (1 byte character data, 1 byte attributes). It is 32 kb in
size.
Hence the offset of a single memory cell from its origin is:
Y*columns*2 + X*2
where X and Y mark the point and columns is the number of character cells
per line
where X and Y mark the point and columns is the number of character
cells per line
}
uses crt, { keypressed(), gotoxy(), randomize(), random(), wherex(),
wherey() }
uses
crt,
go32;
const columns = 80; { number of columns on screen }
rows = 25; { number of rows on screen }
const
{ number of columns on screen }
columns = 80;
{ number of rows on screen }
rows = 25;
screensize = rows*columns*2;
text = '! Hello world !'; { sample text string }
{ sample text string }
text = '! Hello world !';
var textofs : Longint;
save_screen : array[0..screensize-1] of byte; { this variable holds the
entire screen contents }
curx, cury : Integer; { These two hold the previous cursor coordinates }
var
textofs : Longint;
{ this variable holds the entire screen contents }
save_screen : array[0..screensize-1] of byte;
{ These two hold the previous cursor coordinates }
curx, cury : Integer;
begin
randomize;
@ -49,25 +52,25 @@ begin
curx := wherex; cury := wherey;
{ This is our demo text }
gotoxy(1, 1); Write(text);
{ calculate the address in offscreen memory (to be sure it won't be over
written by the copy process later, we don't put it exactly at the end
of the visible screen area) }
{ calculate the address in offscreen memory (to be sure it will
not be overwritten by the copy process later, we don't put it
exactly at the end of the visible screen area) }
textofs := screensize + length(text)*2;
{ copy it to offscreen memory }
dosmemmove($B800, 0, $B800, textofs, length(text)*2);
{ clear the screen by writing zeros on the whole visible screen}
dosmemfillchar($B800, 0, screensize, #0);
while (not keypressed) do begin
{ set the attribute field (byte 2 of every cell) of the text in
offscreen memory to random values }
{ set the attribute field (byte 2 of every cell) of the
text in offscreen memory to random values }
dosmemfillchar($B800, textofs + random(length(text))*2 + 1,
1, char(random(255)));
{ copy the string from offscreen to visibly screen by calculating
it's destination address randomly }
dosmemmove($B800, textofs,
$B800, random(columns)*2+random(rows)*columns*2,
dosmemmove($B800, textofs, $B800,
random(columns)*2+random(rows)*columns*2,
length(text)*2);
{ small delay, else it is too fast (remove it if you want...) }
{ small delay, else it is too fast }
delay(1);
end;
{ clear the keyboard buffer }

18
docs/go32ex/textmess.pp
View File

@ -1,14 +1,16 @@
Program textmess;
uses
crt,
go32;
uses crt, go32;
const columns = 80;
const
columns = 80;
rows = 25;
screensize = rows*columns*2;
text = '! Hello world !';
var textofs : Longint;
var
textofs : Longint;
save_screen : array[0..screensize-1] of byte;
curx, cury : Integer;
@ -20,10 +22,8 @@ begin
textofs := screensize + length(text)*2;
dosmemmove($B800, 0, $B800, textofs, length(text)*2);
dosmemfillchar($B800, 0, screensize, #0);
while (not keypressed) do
begin
dosmemfillchar($B800,
textofs + random(length(text))*2 + 1,
while (not keypressed) do begin
dosmemfillchar($B800, textofs + random(length(text))*2 + 1,
1, char(random(255)));
dosmemmove($B800, textofs, $B800,
random(columns)*2+random(rows)*columns*2,

29
docs/go32ex/vgasel.pas
View File

@ -1,29 +1,24 @@
{ example for :
Selectors and descriptors
segment_to_descriptor()
seg_fillchar()
realintr()
trealregs record
}
{ This example demonstrates the use of the segment_to_descriptor() function.
{This example demonstrates the use of the segment_to_descriptor()
function.
It switches to VGA mode 13h (320x200x256 color), creates a selector to the
memory (based at $A000:0000), clears this memory with color 15 (white) and
waits until the enter key is pressed
}
It switches to VGA mode 13h (320x200x256 color), creates a selector
to the memory (based at $A000:0000), clears this memory with color
15 (white) and waits until the enter key is pressed }
uses go32;
var vgasel : Word;
var
vgasel : Word;
r : trealregs;
begin
{ set VGA mode 13h }
r.eax := $13; realintr($10, r);
{ allocate descriptor to VGA memory quickly; it could be done with
allocate_ldt_descriptors() too, but we would have to initialize it
by ourselves... unlike segment_to_descriptor() which automatically sets
the limit and the base address correctly }
{ allocate descriptor to VGA memory quickly; it could be done
with allocate_ldt_descriptors() too, but we would have to
initialize it by ourselves... unlike segment_to_descriptor()
which automatically sets the limit and the base address
correctly }
vgasel := segment_to_descriptor($A000);
{ simply fill the screen memory with color 15 }
seg_fillchar(vgasel, 0, 64000, #15);

13
docs/go32ex/vgasel.pp
View File

@ -1,17 +1,14 @@
Program svgasel;
uses
go32;
uses go32;
var vgasel : Word;
var
vgasel : Word;
r : trealregs;
begin
r.eax := $13; realintr($10, r);
vgasel := segment_to_descriptor($A000);
{ simply fill the screen memory with color 15 }
seg_fillchar(vgasel, 0, 64000, #15);
readln;
{ back to text mode }
r.eax := $3;
realintr($10, r);
r.eax := $3; realintr($10, r);
end.