paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 09:28:19 +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

242
docs/go32ex/buffer.pas
View File

@ -1,118 +1,126 @@
{ 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.
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:
Int 10h 4f00h : VESA BIOS extension installation check
Input : AX = 4F00h
ES:DI = pointer to 512 byte information buffer
Output : AX = 004Fh if successful
ES:DI = pointer to filled buffer
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
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;
{ 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;
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 }
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 }
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 }
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 }
Version : Word;
reserved : array[0..505] of byte; { pad to 512 bytes length }
end;
var selector, { selector to our real mode buffer }
segment : Word; { real mode segment address of buffer }
r : trealregs; { register structure to issue a software interrupt }
infobuf : VBEInfoBuf;
begin
{ first we reset the registers and infobuf variable }
fillchar(r, sizeof(r), 0);
fillchar(infobuf, sizeof(VBEInfoBuf), 0);
{ allocate real mode memory }
dosalloc(selector, segment, sizeof(VBEInfoBuf));
{ check if an error occured during allocation }
if (int31error<>0) then begin
Writeln('Error while allocating real mode memory, halting');
halt;
end;
{ request VBE 2.0 information, fill out information buffer }
infobuf.Signature := 'VBE2';
{ copy buffer to the allocated real mode memory }
dosmemput(segment, 0, infobuf, sizeof(infobuf));
{ issue the interrupt; remember : DI = 0 }
r.ax := $4f00; r.es := segment;
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 }
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');
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');
end;
{ 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.
Here's the necessary interrupt call description:
Int 10h 4f00h : VESA BIOS extension installation check
Input : AX = 4F00h
ES:DI = pointer to 512 byte information buffer
Output : AX = 004Fh if successful
ES:DI = pointer to filled buffer
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
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;
{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;
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 }
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 }
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}
procedure dosfree(selector : word);
begin
{ call the GO32 function with the selector }
global_dos_free(selector);
end;
type
VBEInfoBuf = packed record
{ contains 'VESA' if successful }
Signature : array[0..3] of char;
Version : Word;
{ pad to 512 bytes length }
reserved : array[0..505] of byte;
end;
var
{ selector to our real mode buffer }
selector,
{ real mode segment address of buffer }
segment : Word;
{ register structure to issue a software interrupt }
r : trealregs;
infobuf : VBEInfoBuf;
begin
{ first we reset the registers and infobuf variable }
fillchar(r, sizeof(r), 0);
fillchar(infobuf, sizeof(VBEInfoBuf), 0);
{ allocate real mode memory }
dosalloc(selector, segment, sizeof(VBEInfoBuf));
{ check if an error occured during allocation }
if (int31error<>0) then begin
Writeln('Error while allocating real mode memory, halting');
halt;
end;
{ request VBE 2.0 information, fill out information buffer }
infobuf.Signature := 'VBE2';
{ copy buffer to the allocated real mode memory }
dosmemput(segment, 0, infobuf, sizeof(infobuf));
{ issue the interrupt; remember : DI = 0 }
r.ax := $4f00; r.es := segment;
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 }
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');
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');
end;
end.

109
docs/go32ex/buffer.pp
View File

@ -1,52 +1,59 @@
Program buffer;
uses go32;
procedure dosalloc(var selector : word; var segment : word; size : longint);
var res : longint;
begin
res := global_dos_alloc(size);
selector := word(res);
segment := word(res shr 16);
end;
procedure dosfree(selector : word);
begin
global_dos_free(selector);
end;
type VBEInfoBuf = record
Signature : array[0..3] of char;
Version : Word;
reserved : array[0..505] of byte;
end;
var selector,
segment : Word;
r : trealregs;
infobuf : VBEInfoBuf;
begin
fillchar(r, sizeof(r), 0);
fillchar(infobuf, sizeof(VBEInfoBuf), 0);
dosalloc(selector, segment, sizeof(VBEInfoBuf));
if (int31error<>0) then begin
Writeln('Error while allocating real mode memory, halting');
halt;
end;
infobuf.Signature := 'VBE2';
dosmemput(segment, 0, infobuf, sizeof(infobuf));
r.ax := $4f00; r.es := segment;
realintr($10, r);
dosmemget(segment, 0, infobuf, sizeof(infobuf));
dosfree(selector);
if (r.ax <> $4f) then begin
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');
end;
uses
go32;
procedure dosalloc(var selector : word;
var segment : word; size : longint);
var
res : longint;
begin
res := global_dos_alloc(size);
selector := word(res);
segment := word(res shr 16);
end;
procedure dosfree(selector : word);
begin
global_dos_free(selector);
end;
type
VBEInfoBuf = packed record
Signature : array[0..3] of char;
Version : Word;
reserved : array[0..505] of byte;
end;
var
selector,
segment : Word;
r : trealregs;
infobuf : VBEInfoBuf;
begin
fillchar(r, sizeof(r), 0);
fillchar(infobuf, sizeof(VBEInfoBuf), 0);
dosalloc(selector, segment, sizeof(VBEInfoBuf));
if (int31error<>0) then begin
Writeln('Error while allocating real mode memory, halting');
halt;
end;
infobuf.Signature := 'VBE2';
dosmemput(segment, 0, infobuf, sizeof(infobuf));
r.ax := $4f00; r.es := segment;
realintr($10, r);
dosmemget(segment, 0, infobuf, sizeof(infobuf));
dosfree(selector);
if (r.ax <> $4f) then begin
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');
end;
end.

463
docs/go32ex/callback.pas
View File

@ -1,227 +1,238 @@
{ 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.
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.
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
Used software interrupt calls (rough descriptions, only what's used):
Int 33h 0000h - Mircosoft 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
Input : AX = 0001h
Return : Mouse cursor shown on screen
Int 33h 0002h - Mircosoft mouse driver : Hide mouse cursor
Input : AX = 0002h
Return : Hides mouse cursor again
Int 33h 000Ch - Mircosoft 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)
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.
BX = button state information
CX = mouse X coordinates
DX = mouse Y coordinates
For more detailed information consult any mouse reference or interrupt list.
}
uses crt, { keypressed(), gotoxy(), wherey(), clrscr() }
go32;
const mouseint = $33; { the mouse interrupt number }
var mouse_regs : trealregs; { supplied register structure to the callback }
mouse_seginfo : tseginfo; { real mode 48 bit pointer to the callback }
var mouse_numbuttons : longint;{ number of mouse buttons }
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 }
userproc_installed : Longbool; { is an additional user procedure installed }
userproc_length : Longint; { length of additional user procedure }
userproc_proc : pointer; { pointer to user proc }
{$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 }
{ give control to user procedure if installed }
cmpl $1, _USERPROC_INSTALLED
je .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 %ax, %fs { set fs for FPC }
call *_USERPROC_PROC
popal
.LNoCallback:
popl %esi
popl %edi
popw %ds
popw %es
movl (%esi), %eax
movl %eax, %es: 42(%edi) { adjust stack }
addw $4, %es: 46(%edi)
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.
}
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 }
procedure textuserproc;
begin
{ the mouse_regs record contains the real mode registers now }
mouse_b := mouse_regs.bx;
mouse_x := (mouse_regs.cx shr 3) + 1;
mouse_y := (mouse_regs.dx shr 3) + 1;
end;
{ 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
}
procedure install_mouse(userproc : pointer; userproclen : longint);
var r : trealregs;
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');
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 }
if (userproc <> nil) then begin
userproc_proc := userproc;
userproc_installed := true;
userproc_length := userproclen;
{ lock code for user procedure }
lock_code(userproc_proc, userproc_length);
end else begin
{ clear variables }
userproc_proc := nil;
userproc_length := 0;
userproc_installed := false;
end;
{ lock code & data which is touched in the callback handler }
lock_data(mouse_x, sizeof(mouse_x));
lock_data(mouse_y, sizeof(mouse_y));
lock_data(mouse_b, sizeof(mouse_b));
lock_data(mouse_action, sizeof(mouse_action));
lock_data(userproc_installed, sizeof(userproc_installed));
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));
{ 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.es := mouse_seginfo.segment;
realintr(mouseint, r);
{ show mouse cursor }
r.eax := $01;
realintr(mouseint, r);
end;
procedure remove_mouse;
var r : trealregs;
begin
{ hide mouse cursor }
r.eax := $02; realintr(mouseint, r);
{ remove callback handler }
r.eax := $0c; r.ecx := 0; r.edx := 0; r.es := 0;
realintr(mouseint, r);
{ free callback }
free_rm_callback(mouse_seginfo);
{ 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;
userproc_length := 0;
userproc_installed := false;
end;
{ unlock used code & data }
unlock_data(mouse_x, sizeof(mouse_x));
unlock_data(mouse_y, sizeof(mouse_y));
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(mouse_regs, sizeof(mouse_regs));
unlock_data(mouse_seginfo, sizeof(mouse_seginfo));
unlock_code(@callback_handler, longint(@mouse_dummy)-longint(@callback_handler));
fillchar(mouse_seginfo, sizeof(mouse_seginfo), 0);
end;
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, ' Buttons : ', mouse_b:2);
end;
remove_mouse;
{ 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 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
Used software interrupt calls (rough descriptions, only what's used):
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 - Microsoft Mouse driver : Show mouse cursor
Input : AX = 0001h
Return : Mouse cursor shown on screen
Int 33h 0002h - Microsoft mouse driver : Hide mouse cursor
Input : AX = 0002h
Return : Hides mouse cursor again
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 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.
BX = button state information
CX = mouse X coordinates
DX = mouse Y coordinates
For more detailed information consult any mouse reference or
interrupt list.
}
{$ASMMODE ATT}
{$MODE FPC}
uses
crt,
go32;
const
{ the mouse interrupt number }
mouseint = $33;
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
{ number of mouse buttons }
mouse_numbuttons : longint;
{ 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;
{ 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 }
{ callback control handler, calls a user procedure if installed }
procedure callback_handler; assembler;
asm
pushw %ds
pushl %eax
movw %es, %ax
movw %ax, %ds
{ give control to user procedure if installed }
cmpl $1, USERPROC_INSTALLED
jne .LNoCallback
pushal
movw DOSmemSELECTOR, %ax
movw %ax, %fs { set fs for FPC }
call *USERPROC_PROC
popal
.LNoCallback:
popl %eax
popw %ds
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.
}
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 }
procedure textuserproc;
begin
{ the mouse_regs record contains the real mode registers now }
mouse_b := mouse_regs.bx;
mouse_x := (mouse_regs.cx shr 3) + 1;
mouse_y := (mouse_regs.dx shr 3) + 1;
end;
{ 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
}
procedure install_mouse(userproc : pointer; userproclen : longint);
var r : trealregs;
begin
{ mouse driver reset }
r.eax := $0; realintr(mouseint, r);
if (r.eax <> $FFFF) then begin
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 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;
userproc_length := userproclen;
{ lock code for user procedure }
lock_code(userproc_proc, userproc_length);
end else begin
{ clear variables }
userproc_proc := nil;
userproc_length := 0;
userproc_installed := false;
end;
{ lock code & data which is touched in the callback handler }
lock_data(mouse_x, sizeof(mouse_x));
lock_data(mouse_y, sizeof(mouse_y));
lock_data(mouse_b, sizeof(mouse_b));
lock_data(mouse_action, sizeof(mouse_action));
lock_data(userproc_installed, sizeof(userproc_installed));
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));
{ 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.es := mouse_seginfo.segment;
realintr(mouseint, r);
{ show mouse cursor }
r.eax := $01;
realintr(mouseint, r);
end;
procedure remove_mouse;
var
r : trealregs;
begin
{ hide mouse cursor }
r.eax := $02; realintr(mouseint, r);
{ remove callback handler }
r.eax := $0c; r.ecx := 0; r.edx := 0; r.es := 0;
realintr(mouseint, r);
{ free callback }
free_rm_callback(mouse_seginfo);
{ 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;
userproc_length := 0;
userproc_installed := false;
end;
{ unlock used code & data }
unlock_data(mouse_x, sizeof(mouse_x));
unlock_data(mouse_y, sizeof(mouse_y));
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(mouse_regs, sizeof(mouse_regs));
unlock_data(mouse_seginfo, sizeof(mouse_seginfo));
unlock_code(@callback_handler,
longint(@mouse_dummy)-longint(@callback_handler));
fillchar(mouse_seginfo, sizeof(mouse_seginfo), 0);
end;
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,
' Buttons : ', mouse_b:2);
end;
remove_mouse;
end.

290
docs/go32ex/callback.pp
View File

@ -1,147 +1,145 @@
Program callback;
uses crt,
go32;
const mouseint = $33;
var mouse_regs : trealregs;
mouse_seginfo : tseginfo;
var mouse_numbuttons : longint;
mouse_action : word;
mouse_x, mouse_y : Word;
mouse_b : Word;
userproc_installed : Longbool;
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
movw %es, %ax
movw %ax, %ds
movw U_GO32_DOSMEMSELECTOR, %ax
movw %ax, %fs
call *_USERPROC_PROC
popal
.LNoCallback:
popl %esi
popl %edi
popw %ds
popw %es
movl (%esi), %eax
movl %eax, %es: 42(%edi)
addw $4, %es: 46(%edi)
iret
end;
procedure mouse_dummy; begin end;
procedure textuserproc;
begin
mouse_b := mouse_regs.bx;
mouse_x := (mouse_regs.cx shr 3) + 1;
mouse_y := (mouse_regs.dx shr 3) + 1;
end;
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');
halt;
end;
if (r.bx = $ffff) then mouse_numbuttons := 2
else mouse_numbuttons := r.bx;
Writeln(mouse_numbuttons,
' button Mircosoft compatible mouse found.');
if (userproc <> nil) then begin
userproc_proc := userproc;
userproc_installed := true;
userproc_length := userproclen;
lock_code(userproc_proc, userproc_length);
end else begin
userproc_proc := nil;
userproc_length := 0;
userproc_installed := false;
end;
lock_data(mouse_x, sizeof(mouse_x));
lock_data(mouse_y, sizeof(mouse_y));
lock_data(mouse_b, sizeof(mouse_b));
lock_data(mouse_action, sizeof(mouse_action));
lock_data(userproc_installed, sizeof(userproc_installed));
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));
get_rm_callback(@callback_handler, mouse_regs, mouse_seginfo);
r.eax := $0c; r.ecx := $7f; r.edx := longint(mouse_seginfo.offset);
r.es := mouse_seginfo.segment;
realintr(mouseint, r);
r.eax := $01;
realintr(mouseint, r);
end;
procedure remove_mouse;
var r : trealregs;
begin
r.eax := $02; realintr(mouseint, r);
r.eax := $0c; r.ecx := 0; r.edx := 0; r.es := 0;
realintr(mouseint, r);
free_rm_callback(mouse_seginfo);
if (userproc_installed) then begin
unlock_code(userproc_proc, userproc_length);
userproc_proc := nil;
userproc_length := 0;
userproc_installed := false;
end;
unlock_data(mouse_x, sizeof(mouse_x));
unlock_data(mouse_y, sizeof(mouse_y));
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(mouse_regs, sizeof(mouse_regs));
unlock_data(mouse_seginfo, sizeof(mouse_seginfo));
unlock_code(@callback_handler,
longint(@mouse_dummy)
- longint(@callback_handler));
fillchar(mouse_seginfo, sizeof(mouse_seginfo), 0);
end;
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,
' Buttons : ', mouse_b:2);
end;
remove_mouse;
{$ASMMODE ATT}
{$MODE FPC}
uses
crt,
go32;
const
mouseint = $33;
var
mouse_regs : trealregs; external name '___v2prt0_rmcb_regs';
mouse_seginfo : tseginfo;
var
mouse_numbuttons : longint;
mouse_action : word;
mouse_x, mouse_y : Word;
mouse_b : Word;
userproc_installed : Longbool;
userproc_length : Longint;
userproc_proc : pointer;
procedure callback_handler; assembler;
asm
pushw %ds
pushl %eax
movw %es, %ax
movw %ax, %ds
cmpl $1, USERPROC_INSTALLED
jne .LNoCallback
pushal
movw DOSmemSELECTOR, %ax
movw %ax, %fs
call *USERPROC_PROC
popal
.LNoCallback:
popl %eax
popw %ds
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;
begin
mouse_b := mouse_regs.bx;
mouse_x := (mouse_regs.cx shr 3) + 1;
mouse_y := (mouse_regs.dx shr 3) + 1;
end;
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 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 Microsoft compatible mouse ',
' found.');
if (userproc <> nil) then begin
userproc_proc := userproc;
userproc_installed := true;
userproc_length := userproclen;
lock_code(userproc_proc, userproc_length);
end else begin
userproc_proc := nil;
userproc_length := 0;
userproc_installed := false;
end;
lock_data(mouse_x, sizeof(mouse_x));
lock_data(mouse_y, sizeof(mouse_y));
lock_data(mouse_b, sizeof(mouse_b));
lock_data(mouse_action, sizeof(mouse_action));
lock_data(userproc_installed, sizeof(userproc_installed));
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));
get_rm_callback(@callback_handler, mouse_regs, mouse_seginfo);
r.eax := $0c; r.ecx := $7f;
r.edx := longint(mouse_seginfo.offset);
r.es := mouse_seginfo.segment;
realintr(mouseint, r);
r.eax := $01;
realintr(mouseint, r);
end;
procedure remove_mouse;
var
r : trealregs;
begin
r.eax := $02; realintr(mouseint, r);
r.eax := $0c; r.ecx := 0; r.edx := 0; r.es := 0;
realintr(mouseint, r);
free_rm_callback(mouse_seginfo);
if (userproc_installed) then begin
unlock_code(userproc_proc, userproc_length);
userproc_proc := nil;
userproc_length := 0;
userproc_installed := false;
end;
unlock_data(mouse_x, sizeof(mouse_x));
unlock_data(mouse_y, sizeof(mouse_y));
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(mouse_regs, sizeof(mouse_regs));
unlock_data(mouse_seginfo, sizeof(mouse_seginfo));
unlock_code(@callback_handler,
longint(@mouse_dummy)-longint(@callback_handler));
fillchar(mouse_seginfo, sizeof(mouse_seginfo), 0);
end;
begin
install_mouse(@textuserproc, 400);
Writeln('Press any key to exit...');
while (not keypressed) do begin
gotoxy(1, wherey);
write('MouseX : ', mouse_x:2, ' MouseY : ', mouse_y:2,
' Buttons : ', mouse_b:2);
end;
remove_mouse;
end.

63
docs/go32ex/flags.pas
View File

@ -1,33 +1,32 @@
{ example for :
realintr()
flags constants
trealregs record
}
{ 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.
Int 15h 5300h - APM specification : Installation check
Input : AX = 5300h
BX = device id of system BIOS (= 0000h)
Return : Carry clear if successful
AH = major version (BCD)
AL = minor version (BCD)
}
uses go32;
var r : trealregs;
begin
{ set register values and issue real mode interrupt call }
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');
end else
Writeln('APM not present');
{ 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.
Int 15h 5300h - APM specification : Installation check
Input : AX = 5300h
BX = device id of system BIOS (= 0000h)
Return : Carry clear if successful
AH = major version (BCD)
AL = minor version (BCD)
}
uses
go32;
var
r : trealregs;
begin
{ set register values and issue real mode interrupt call }
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');
end else
Writeln('APM not present');
end.

32
docs/go32ex/flags.pp
View File

@ -1,18 +1,16 @@
Program flags;
uses go32;
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');
end else
Writeln('APM not present');
uses
go32;
var
r : trealregs;
begin
r.ax := $5300;
r.bx := 0;
realintr($15, r);
if ((r.flags and carryflag)=0) then begin
Writeln('APM v', (r.ah and $f), '.',
(r.al shr 4), (r.al and $f), ' detected');
end else
Writeln('APM not present');
end.

42
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;
begin
{ depending on the detected environment we simply write another message
}
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');
end;
{ Simply write a message according to the current environment }
uses
go32;
begin
{ 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');
end;
end.

44
docs/go32ex/getrunmd.pp
View File

@ -1,26 +1,20 @@
Program getrunmd;
uses go32;
begin
{
depending on the detected environment,
we simply write another message
}
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');
end;
uses
go32;
begin
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');
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.

32
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;
newint1c : tseginfo;
var oldint1c : tseginfo;
newint1c : tseginfo;
int1c_counter : Longint;
int1c_counter : Longint;
int1c_ds : Word; external name '___v2prt0_ds_alias';
{$ASMMODE DIRECT}
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);
gotoxy(1, wherey);
write('Number of interrupts occured : ', int1c_counter);
end;
set_pm_interrupt(int1c, oldint1c);
end.

235
docs/go32ex/keyclick.pas
View File

@ -1,118 +1,119 @@
{ 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.
}
uses crt, { readkey() }
go32;
const kbdint = $9; { keyboard is IRQ 1 -> interrupt 9 }
var oldint9_handler : tseginfo; { holds old PM interrupt handler address }
newint9_handler : tseginfo; { new PM interrupt handler }
clickproc : pointer; { pointer to interrupt handler }
{$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 }
pushal
{ set up to call a FPC procedure }
movw %cs:INT9_DS, %ax
movw %ax, %ds
movw %ax, %es
movw U_GO32_DOSMEMSELECTOR, %ax
movw %ax, %fs
{ call user procedure }
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
end;
{ 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 }
procedure clicker;
begin
sound(500); delay(10); nosound;
end;
{ dummy procedure to retrieve exact length of user procedure for locking and
unlocking functions }
procedure clicker_dummy; begin end;
{ installs our new handler }
procedure install_click;
begin
clickproc := @clicker;
{ lock used code and data }
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));
{ 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;
{ deinstalls our interrupt handler }
procedure remove_click;
begin
{ set old handler }
set_pm_interrupt(kbdint, oldint9_handler);
{ unlock used code & data }
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));
end;
var ch : char;
begin
install_click;
Writeln('Enter any message. Press return when finished');
while (ch <> #13) do begin
ch := readkey; write(ch);
end;
remove_click;
{ 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.
}
{$ASMMODE ATT}
{$MODE FPC}
uses
crt,
go32;
const
{ keyboard is IRQ 1 -> interrupt 9 }
kbdint = $9;
var
{ holds old PM interrupt handler address }
oldint9_handler : tseginfo;
{ new PM interrupt handler }
newint9_handler : tseginfo;
{ pointer to interrupt handler }
clickproc : pointer;
{ the data segment selector }
backupDS : Word; external name '___v2prt0_ds_alias';
{ interrupt handler }
procedure int9_handler; assembler;
asm
cli
{ 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:backupDS, %ax
movw %ax, %ds
movw %ax, %es
movw dosmemselector, %ax
movw %ax, %fs
{ call user procedure }
call *clickproc
{ restore all registers }
popal
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 }
procedure int9_dummy; begin end;
{ demo user procedure, simply clicks on every keypress }
procedure clicker;
begin
sound(500); delay(10); nosound;
end;
{ dummy procedure to retrieve exact length of user procedure for
locking and unlocking functions }
procedure clicker_dummy; begin end;
{ installs our new handler }
procedure install_click;
begin
clickproc := @clicker;
{ lock used code and data }
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));
{ 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);
{ set the new interrupt handler }
set_pm_interrupt(kbdint, newint9_handler);
end;
{ deinstalls our interrupt handler }
procedure remove_click;
begin
{ set old handler }
set_pm_interrupt(kbdint, oldint9_handler);
{ unlock used code & data }
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));
end;
var
ch : char;
begin
install_click;
Writeln('Enter any message. Press return when finished');
while (ch <> #13) do begin
ch := readkey; write(ch);
end;
remove_click;
end.

176
docs/go32ex/keyclick.pp
View File

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

90
docs/go32ex/meminfo.pas
View File

@ -1,43 +1,49 @@
{ 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;
var meminfo : tmeminfo;
begin
get_meminfo(meminfo);
if (int31error <> 0) then begin
Writeln('Error getting DPMI memory information... Halting');
Writeln('DPMI error number : ', int31error);
end else begin
with meminfo do begin
Writeln('Largest available free block : ', available_memory div 1024, ' kbytes');
if (available_pages <> -1) then
Writeln('Maximum available unlocked pages : ', available_pages);
if (available_lockable_pages <> -1) then
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');
if (unlocked_pages <> -1) then
Writeln('Total number of unlocked pages : ', unlocked_pages);
if (available_physical_pages <> -1) then
Writeln('Total number of free pages : ', available_physical_pages);
if (total_physical_pages <> -1) then
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');
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');
end;
end;
{ Shows how to obtain memory information via get_meminfo();
notice the checks if any of the returned information is invalid (-1)
}
uses
go32;
var
meminfo : tmeminfo;
begin
get_meminfo(meminfo);
if (int31error <> 0) then begin
Writeln('Error getting DPMI memory information... Halting');
Writeln('DPMI error number : ', int31error);
end else begin
with meminfo do begin
Writeln('Largest available free block : ',
available_memory div 1024, ' kbytes');
if (available_pages <> -1) then
Writeln('Maximum available unlocked pages : ',
available_pages);
if (available_lockable_pages <> -1) then
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');
if (unlocked_pages <> -1) then
Writeln('Total number of unlocked pages : ',
unlocked_pages);
if (available_physical_pages <> -1) then
Writeln('Total number of free pages : ',
available_physical_pages);
if (total_physical_pages <> -1) then
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');
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');
end;
end;
end.

89
docs/go32ex/meminfo.pp
View File

@ -1,47 +1,44 @@
Program meminf;
uses go32;
var meminfo : tmeminfo;
begin
get_meminfo(meminfo);
if (int31error <> 0) then
begin
Writeln('Error getting DPMI memory information... Halting');
Writeln('DPMI error number : ', int31error);
end
else
with meminfo do
begin
Writeln('Largest available free block : ',
available_memory div 1024, ' kbytes');
if (available_pages <> -1) then
Writeln('Maximum available unlocked pages : ',
available_pages);
if (available_lockable_pages <> -1) then
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');
if (unlocked_pages <> -1) then
Writeln('Total number of unlocked pages : ',
unlocked_pages);
if (available_physical_pages <> -1) then
Writeln('Total number of free pages : ',
available_physical_pages);
if (total_physical_pages <> -1) then
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');
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');
end;
uses
go32;
var
meminfo : tmeminfo;
begin
get_meminfo(meminfo);
if (int31error <> 0) then begin
Writeln('Error getting DPMI memory information... Halting');
Writeln('DPMI error number : ', int31error);
end else begin
with meminfo do begin
Writeln('Largest available free block : ',
available_memory div 1024, ' kbytes');
if (available_pages <> -1) then
Writeln('Maximum available unlocked pages : ',
available_pages);
if (available_lockable_pages <> -1) then
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');
if (unlocked_pages <> -1) then
Writeln('Total number of unlocked pages : ',
unlocked_pages);
if (available_physical_pages <> -1) then
Writeln('Total number of free pages : ',
available_physical_pages);
if (total_physical_pages <> -1) then
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');
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');
end;
end;
end.

33
docs/go32ex/outport.pas
View File

@ -1,19 +1,16 @@
{ 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.
}
uses crt,
go32;
begin
{ turn on speaker }
outportb($61, $ff);
{ wait a little bit }
delay(50);
{ turn it off again }
outportb($61, $0);
{ This example demonstrates the use of the outport functions.
It simply turns the PC's internal speaker on for 50 ms and off again
}
uses
crt,
go32;
begin
{ turn on speaker }
outportb($61, $ff);
{ wait a little bit }
delay(50);
{ turn it off again }
outportb($61, $0);
end.

19
docs/go32ex/outport.pp
View File

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

142
docs/go32ex/rmpmint.pp
View File

@ -1,92 +1,80 @@
Program rmpm_int;
uses
crt,
go32;
uses crt, go32;
{$ASMMODE DIRECT}
var r : trealregs;
axreg : Word;
oldint21h : tseginfo;
newint21h : tseginfo;
var
r : trealregs;
axreg : Word;
oldint21h : tseginfo;
newint21h : tseginfo;
procedure int21h_handler; assembler;
asm
cmpw $0x3001, %ax
jne CallOld
movw $0x3112, %ax
iret
cmpw $0x3001, %ax
jne .LCallOld
movw $0x3112, %ax
iret
CallOld:
ljmp %cs:OLDHANDLER
OLDHANDLER: .long 0
.word 0
.LCallOld:
ljmp %cs:oldint21h
end;
procedure resume;
begin
Writeln;
Write('-- press any key to resume --'); readkey;
gotoxy(1, wherey); clreol;
Writeln;
Write('-- press any key to resume --'); readkey;
gotoxy(1, wherey); clreol;
end;
begin
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;
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);
asm
movl _OLDINT21H, %eax
movl %eax, OLDHANDLER
movw 4+_OLDINT21H, %ax
movw %ax, 4+OLDHANDLER
end;
set_pm_interrupt($21, newint21h);
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 ');
Writeln('calling interrupts...');
set_pm_interrupt($21, oldint21h);
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.

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.

138
docs/go32ex/seldes.pp
View File

@ -1,40 +1,36 @@
Program sel_des;
{$mode delphi}
uses
crt,
go32;
uses crt,
go32;
const
maxx = 80;
maxy = 25;
bytespercell = 2;
screensize = maxx * maxy * bytespercell;
const maxx = 80;
maxy = 25;
bytespercell = 2;
screensize = maxx * maxy * bytespercell;
linB8000 = $B800 * 16;
linB8000 = $B800 * 16;
type string80 = string[80];
type
string80 = string[80];
var
text_save : array[0..screensize-1] of byte;
text_oldx, text_oldy : Word;
text_save : array[0..screensize-1] of byte;
text_oldx, text_oldy : Word;
text_sel : Word;
text_sel : Word;
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 : $',
hexstr(get_segment_base_address(sel), 8));
clreol;
write('Descriptor limit : ',
get_segment_limit(sel));
gotoxy(1, 24);
clreol; writeln('Descriptor base address : $',
hexstr(get_segment_base_address(sel), 8));
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);
text_oldx := wherex; text_oldy := wherey;
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');
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);
selinfo(text_sel);
seg_move(dosmemselector, linB8000, get_ds, longint(@text_save),
screensize);
text_oldx := wherex; text_oldy := wherey;
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');
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);
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,
makechar(' ', LightBlue shl 4));
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');
set_segment_base_address(text_sel,
get_segment_base_address(text_sel)
+ bytespercell * maxx);
set_segment_limit(text_sel,
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,
makechar(#176, LightMagenta or Brown shl 4));
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);
set_segment_limit(text_sel,
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,
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');
free_ldt_descriptor(text_sel);
seg_move(get_ds, longint(@text_save),
dosmemselector, linB8000, screensize);
gotoxy(text_oldx, text_oldy);
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);
gotoxy(text_oldx, text_oldy);
end.

58
docs/go32ex/softint.pas
View File

@ -1,35 +1,25 @@
{ 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
AL = $1
Return: AL = major version number
AH = minor version number
}
uses go32; { realintr, 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);
Writeln('DOS v', r.al,'.',r.ah, ' detected');
{ 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
AL = $1
Return:
AL = major version number
AH = minor version number
}
uses
go32;
var
r : trealregs;
begin
r.ah := $30;
r.al := $01;
realintr($21, r);
Writeln('DOS v', r.al,'.',r.ah, ' detected');
end.

21
docs/go32ex/softint.pp
View File

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

161
docs/go32ex/textmess.pas
View File

@ -1,80 +1,83 @@
{ Example for : dosmemmove()
dosmemfillchar()
dosmemget()
DOS memory access
}
{ 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.
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
}
uses crt, { keypressed(), gotoxy(), randomize(), random(), wherex(),
wherey() }
go32;
const columns = 80; { number of columns on screen }
rows = 25; { number of rows on screen }
screensize = rows*columns*2;
text = '! Hello world !'; { sample text string }
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 }
begin
randomize;
{ save screen contents to save_screen variable }
dosmemget($B800, 0, save_screen, screensize);
{ save current cursor coordinates }
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) }
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 }
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,
length(text)*2);
{ small delay, else it is too fast (remove it if you want...) }
delay(1);
end;
{ clear the keyboard buffer }
readkey;
{ wait for a keypress }
readkey;
{ restore old screen contents afterwards }
dosmemput($B800, 0, save_screen, screensize);
gotoxy(curx, cury);
{ 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.
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
}
uses
crt,
go32;
const
{ number of columns on screen }
columns = 80;
{ number of rows on screen }
rows = 25;
screensize = rows*columns*2;
{ sample text string }
text = '! Hello world !';
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;
{ save screen contents to save_screen variable }
dosmemget($B800, 0, save_screen, screensize);
{ save current cursor coordinates }
curx := wherex; cury := wherey;
{ This is our demo text }
gotoxy(1, 1); Write(text);
{ 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 }
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,
length(text)*2);
{ small delay, else it is too fast }
delay(1);
end;
{ clear the keyboard buffer }
readkey;
{ wait for a keypress }
readkey;
{ restore old screen contents afterwards }
dosmemput($B800, 0, save_screen, screensize);
gotoxy(curx, cury);
end.

72
docs/go32ex/textmess.pp
View File

@ -1,37 +1,37 @@
Program textmess;
uses crt, go32;
const columns = 80;
rows = 25;
screensize = rows*columns*2;
text = '! Hello world !';
var textofs : Longint;
save_screen : array[0..screensize-1] of byte;
curx, cury : Integer;
begin
randomize;
dosmemget($B800, 0, save_screen, screensize);
curx := wherex; cury := wherey;
gotoxy(1, 1); Write(text);
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,
1, char(random(255)));
dosmemmove($B800, textofs, $B800,
random(columns)*2+random(rows)*columns*2,
length(text)*2);
delay(1);
end;
readkey;
readkey;
dosmemput($B800, 0, save_screen, screensize);
gotoxy(curx, cury);
uses
crt,
go32;
const
columns = 80;
rows = 25;
screensize = rows*columns*2;
text = '! Hello world !';
var
textofs : Longint;
save_screen : array[0..screensize-1] of byte;
curx, cury : Integer;
begin
randomize;
dosmemget($B800, 0, save_screen, screensize);
curx := wherex; cury := wherey;
gotoxy(1, 1); Write(text);
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,
1, char(random(255)));
dosmemmove($B800, textofs, $B800,
random(columns)*2+random(rows)*columns*2,
length(text)*2);
delay(1);
end;
readkey;
readkey;
dosmemput($B800, 0, save_screen, screensize);
gotoxy(curx, cury);
end.

63
docs/go32ex/vgasel.pas
View File

@ -1,35 +1,30 @@
{ example for :
Selectors and descriptors
segment_to_descriptor()
seg_fillchar()
realintr()
trealregs record
}
{ 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
}
uses go32;
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 }
vgasel := segment_to_descriptor($A000);
{ simply fill the screen memory with color 15 }
seg_fillchar(vgasel, 0, 64000, #15);
{ wait for a return press }
readln;
{ back to text mode }
r.eax := $3; realintr($10, r);
{ don't deallocate vgasel, that can't be done }
{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 }
uses go32;
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 }
vgasel := segment_to_descriptor($A000);
{ simply fill the screen memory with color 15 }
seg_fillchar(vgasel, 0, 64000, #15);
{ wait for a return press }
readln;
{ back to text mode }
r.eax := $3; realintr($10, r);
{ don't deallocate vgasel, that can't be done }
end.

29
docs/go32ex/vgasel.pp
View File

@ -1,17 +1,14 @@
Program svgasel;
uses go32;
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);
uses
go32;
var
vgasel : Word;
r : trealregs;
begin
r.eax := $13; realintr($10, r);
vgasel := segment_to_descriptor($A000);
seg_fillchar(vgasel, 0, 64000, #15);
readln;
r.eax := $3; realintr($10, r);
end.