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

* Brings OS/2 directory up to date.

Browse Source
This commit is contained in:
daniel 1998-04-09 08:24:11 +00:00
parent 2938e014d2
commit 12fb25a920
34 changed files with 8193 additions and 4164 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
rtl/os2/atx.pas
View File

@ -1,15 +1,15 @@
program atx;
var f:text;
s:string;
var f:text;
s:string;
begin
assign(f,'c:\autoexec.bat');
reset(f);
while not eof(f) do
begin
readln(f,s);
writeln(s);
end;
close(f);
end.
assign(f,'c:\autoexec.bat');
reset(f);
while not eof(f) do
begin
readln(f,s);
writeln(s);
end;
close(f);
end.

1
rtl/os2/bind.btm
View File

@ -1 +0,0 @@
emxbind -k64 -o %1.exe %1 -aim -s5120

16
rtl/os2/calc_e.pas
View File

@ -2,14 +2,14 @@ program calc_e;
{Calculate the number e.}
const fac:array[0..7] of word=(1,1,2,6,24,120,720,5040);
const fac:array[0..7] of word=(1,1,2,6,24,120,720,5040);
var e:fixed;
i:byte;
var e:fixed;
i:byte;
begin
e:=0;
for i:=0 to 7 do
e:=e+fixed(1)/fac[i];
writeln(e);
end.
e:=0;
for i:=0 to 7 do
e:=e+fixed(1)/fac[i];
writeln(e);
end.

27
rtl/os2/code2.so2 Normal file
View File

@ -0,0 +1,27 @@
/ code2.s (emx+fpk) -- Copyright (c) 1992-1996 by Eberhard Mattes
/ Changed for FPK-Pascal in 1998 by Dani‰l Mantione.
/ This code is _not_ under the Library GNU Public
/ License, because the original is not. See copying.emx
/ for details. You should have received it with this
/ product, write the author if you haven't.
.globl DosGetMessage
.globl _msgseg32
_msgseg32:
.byte 0xff
.asciz "MSGSEG32"
.byte 0x01, 0x80, 0x00, 0x00
.long L_tab
.align 2, 0x90
DosGetMessage:
PROFILE_NOFRAME
popl %ecx /* return address */
pushl $_msgseg32
pushl %ecx
jmp _DOSCALLS$$_DOSTRUEGETMESSAGE$POINTER$PINSERTTABLE$LONGINT$PCHAR$LONGINT$LONGINT$PCHAR$LONGINT
L_tab: .short 0x0000
.short 0xffff

16
rtl/os2/code3.so2 Normal file
View File

@ -0,0 +1,16 @@
/ code3.s (emx+gcc) -- Copyright (c) 1992-1996 by Eberhard Mattes
#include <emx/asm386.h>
.globl _DosQueryMessageCP
_DosQueryMessageCP:
PROFILE_NOFRAME
pushl 0(%esp)
movl $__msgseg32, %eax
xchgl 20(%esp), %eax
xchgl 16(%esp), %eax
xchgl 12(%esp), %eax
xchgl 8(%esp), %eax
movl %eax, 4(%esp)
jmp _DosIQueryMessageCP

1134
rtl/os2/crt.pas
View File

File diff suppressed because it is too large Load Diff

16
rtl/os2/crtdemo.pas
View File

@ -63,19 +63,19 @@ procedure Initialize;
{ generator. Paint the help line. }
begin
OrigMode:=LastMode; { Remember original video mode }
TextMode(_80cols+_50rows); { use 43 or 50 lines on EGA/VGA }
TextMode(_80cols+_50rows); { use 43 or 50 lines on EGA/VGA }
LastCol:=Lo(WindMax)+1; { get last column, row }
LastRow:=Hi(WindMax)+1;
GoToXY(1,LastRow); { put message line on screen }
TextBackground(Black);
TextColor(White);
Write(' Ins-InsLine ',
'Del-DelLine ',
#27#24#25#26'-Cursor ',
'Alt-W-Window ',
'Alt-R-Random ',
'Esc-Exit');
Dec(LastRow,80 div LastCol); { don't write on message line }
Write(' Ins-InsLine '+
'Del-DelLine '+
#27#24#25#26'-Cursor '+
'Alt-W-Window '+
'Alt-R-Random '+
'Esc-Exit');
LastRow:=lastrow-80 div LastCol; { don't write on message line }
Randomize; { init random number generator }
end; { Init }

2143
rtl/os2/dos.pas
View File

File diff suppressed because it is too large Load Diff

4698
rtl/os2/doscalls.pas
View File

File diff suppressed because it is too large Load Diff

19
rtl/os2/dosinit.as
View File

@ -1,19 +0,0 @@
/ emx_386/dosinit.s (emx+gcc) -- Copyright (c) 1994-1996 by Eberhard Mattes
/ In executables created with emxbind, the call to _dos_init will
/ be fixed up at load time to _emx_init of emx.dll. Under DOS,
/ this dummy is called instead as there is no fixup. This module
/ must be linked statically to avoid having two fixups for the
/ same location.
.globl __dos_init
.globl __dos_syscall
__dos_init:
ret $4
.align 2, 0x90
__dos_syscall:
int $0x21
ret

8
rtl/os2/emx.pas
View File

@ -6,7 +6,7 @@ Part of FPK Pascal runtime library for OS/2
History:
2 June 1997 : Creation.
2 June 1997 : Creation.
This unit is copyright (c) 1997 by Dani‰l Mantione.
FPK Pascal is copyright (c) -1997 by Florian Klaempfl.
@ -22,9 +22,9 @@ Modifying this unit is allowed, under the following conditions:
unit emx;
type Pfar=record
segment,offset:word;
end;
type Pfar=record
segment,offset:word;
end;
{! Don't call this one. It is used by the startup code.}
procedure __emxinit;

6
rtl/os2/extest.pas
View File

@ -3,6 +3,6 @@ program extest;
uses dos;
begin
exec('c:\ndos.com','');
writeln(doserror);
end.
exec('c:\ndos.com','');
writeln(doserror);
end.

2
rtl/os2/generic.pas
View File

@ -37,7 +37,7 @@ program generic;
const
frameflags : longint = FCF_TITLEBAR+
FCF_SYSMENU+
FCF_SIZEBORDER+
FCF_SIZEBORDER+
FCF_MINBUTTON+
FCF_MAXBUTTON+
FCF_SHELLPOSITION+

22
rtl/os2/heapsize.pas
View File

@ -1,25 +1,25 @@
program heapsize;
var a:longint;
var a:longint;
procedure writeheapsize;
begin
asm
movl $0x7f00,%ax
xorl %edx,%edx
call ___syscall
mov %eax,_A
end;
writeln(a);
asm
movl $0x7f00,%ax
xorl %edx,%edx
call ___syscall
mov %eax,_A
end;
writeln(a);
end;
begin
writeheapsize;
asm
movl $0x7f00,%ax
movl $327680,%edx
call ___syscall
movl $0x7f00,%ax
movl $327680,%edx
call ___syscall
end;
writeheapsize;
end.

35
rtl/os2/helloos2.pas
View File

@ -1,21 +1,24 @@
program helloos2;
var a,b:^word;
var a,b:^word;
begin
writeln('Hallo Wereld.');
if os_mode=osDOS then
writeln('We draaien onder DOS.')
else
writeln('We draaien onder OS/2.');
writeln('Vrij geheugen: ',memavail);
writeln('Grootste blok: ',maxavail);
writeln('Heapstart: ',longint(heaporg));
writeln('Heapend: ',longint(heapend));
getmem(a,1000);
getmem(b,2000);
a^:=2;
b^:=10;
freemem(a,1000);
freemem(b,2000);
writeln('Hallo Wereld.');
if os_mode=osDOS then
writeln('We draaien onder DOS.')
else
writeln('We draaien onder OS/2.');
writeln('Vrij geheugen: ',memavail);
writeln('Grootste blok: ',maxavail);
writeln('Heapstart: ',longint(heaporg));
writeln('Heapend: ',longint(heapend));
writeln('Geheugen aan het bezetten.');
getmem(a,1000);
getmem(b,2000);
a^:=2;
b^:=10;
writeln('Vrij geheugen: ',memavail);
writeln('Grootste blok: ',maxavail);
freemem(a,1000);
freemem(b,2000);
end.

455
rtl/os2/kbdcalls.pas Normal file
View File

@ -0,0 +1,455 @@
{Set tabsize to 4.}
{****************************************************************************
KBDCALLS interface unit
FPK-Pascal Runtime Library for OS/2
Copyright (c) 1993,94 by Florian Kl„mpfl
Copyright (c) 1997 by Dani‰l Mantione
Copyright (c) 1998 by Tomas Hajny
The FPK-Pascal runtime library is distributed under the Library GNU Public
License v2. So is this unit. The Library GNU Public License requires you to
distribute the source code of this unit with any product that uses it.
Because the EMX library isn't under the LGPL, we grant you an exception to
this, and that is, when you compile a program with the FPK Pascal compiler,
you do not need to ship source code with that program, AS LONG AS YOU ARE
USING UNMODIFIED CODE! If you modify this code, you MUST change the next
line:
<This is an official, unmodified FPK Pascal source code file.>
Send us your modified files, we can work together if you want!
FPK-Pascal is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
Library GNU General Public License for more details.
You should have received a copy of the Library GNU General Public License
along with FPK-Pascal; see the file COPYING.LIB. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.
****************************************************************************}
unit KbdCalls;
{ Interface library to KBDCALLS.DLL (through EMXWRAP.DLL)
Changelog:
People:
TH - Tomas Hajny
Date: Description of change: Changed by:
- First released version 0.99 TH
Coding style:
I have tried to use the same coding style as Dani‰l Mantione in unit
DOSCALLS, although I can't say I would write it the same way otherwise (I
would write much more spaces myself, at least). Try to use it as well,
please. Original note by Dani‰l Mantione follows:
It may be well possible that coding style feels a bit strange to you.
Nevertheless I friendly ask you to try to make your changes not look all
to different. To make life easier, set your IDE to use tab characters,
turn optimal fill, autoindent and backspace unindents on and set a
tabsize of 4.}
{***************************************************************************}
interface
{***************************************************************************}
uses strings;
{$ifdef FPK}
{$packrecords 1}
{$endif FPK}
const
{FnMask}
KR_KBDCHARIN =$00000001;
KR_KBDPEEK =$00000002;
KR_KBDFLUSHBUFFER =$00000004;
KR_KBDGETSTATUS =$00000008;
KR_KBDSETSTATUS =$00000010;
KR_KBDSTRINGIN =$00000020;
KR_KBDOPEN =$00000040;
KR_KBDCLOSE =$00000080;
KR_KBDGETFOCUS =$00000100;
KR_KBDFREEFOCUS =$00000200;
KR_KBDGETCP =$00000400;
KR_KBDSETCP =$00000800;
KR_KBDXLATE =$00001000;
KR_KBDSETCUSTXT =$00002000;
{WaitFlag}
IO_WAIT =0;
{KbdCharIn: wait for a character if one is not available}
{KbdGetFocus: wait for the focus}
IO_NOWAIT =1;
{KbdCharIn: immediate return if no character is available}
{KbdGetFocus: do not wait for the focus}
{TKbdInfo.fsMask}
KEYBOARD_ECHO_ON =$0001;
KEYBOARD_ECHO_OFF =$0002;
KEYBOARD_BINARY_MODE =$0004;
KEYBOARD_ASCII_MODE =$0008;
KEYBOARD_MODIFY_STATE =$0010;
KEYBOARD_MODIFY_INTERIM =$0020;
KEYBOARD_MODIFY_TURNAROUND =$0040;
KEYBOARD_2B_TURNAROUND =$0080;
KEYBOARD_SHIFT_REPORT =$0100;
{TKbdInfo.fsState/TKbdKeyInfo.fsState/TKbdTrans.fsState}
KBDSTF_RIGHTSHIFT =$0001;
KBDSTF_LEFTSHIFT =$0002;
KBDSTF_CONTROL =$0004;
KBDSTF_ALT =$0008;
KBDSTF_SCROLLLOCK_ON =$0010;
KBDSTF_NUMLOCK_ON =$0020;
KBDSTF_CAPSLOCK_ON =$0040;
KBDSTF_INSERT_ON =$0080;
KBDSTF_LEFTCONTROL =$0100;
KBDSTF_LEFTALT =$0200;
KBDSTF_RIGHTCONTROL =$0400;
KBDSTF_RIGHTALT =$0800;
KBDSTF_SCROLLLOCK =$1000;
KBDSTF_NUMLOCK =$2000;
KBDSTF_CAPSLOCK =$4000;
KBDSTF_SYSREQ =$8000;
{TKbdTrans.fbStatus}
KBDTRF_SHIFT_KEY_IN =$01; {shift status returned}
{without character }
KBDTRF_EXTENDED_KEY_IN =$02; {extended key code }
{from the keyboard,}
{not a character }
KBDTRF_CONVERSION_REQUEST =$20; {immediate conversion}
{requested }
KBDTRF_FINAL_CHAR_IN =$40; {either $40 or $80 or both}
KBDTRF_INTERIM_CHAR_IN =$80; {must be present }
type
{TKbdKeyInfo - character data structure for KbdCharIn and KbdPeek}
(* #pragma pack(2) ??? *)
TKbdKeyInfo=record
chChar:char; {ASCII character code; the scan code received}
{from the keyboard is translated to the ASCII}
{character code }
chScan:byte; {scan Code received from the keyboard}
fbStatus:byte; {state of the keystroke event, see KBDTRF_*}
bNlsShift:byte; {NLS shift status (always 0?)}
fsState:word; {shift key status, see KBDSTF_*}
time:longint; {time stamp indicating when a key was pressed,}
{specified in milliseconds from the time }
{the system was started }
end;
PKbdKeyInfo=^TKbdKeyInfo;
{structure for KbdStringIn}
TStringInBuf=record
cb:word;
cchIn:word;
end;
PStringInBuf=TStringInBuf;
{TKbdInfo structure, for KbdSet/GetStatus}
TKbdInfo=record
cb,
fsMask,
chTurnAround,
fsInterim,
fsState:word;
end;
PKbdInfo=^TKbdInfo;
{structure for KbdGetHWID}
TKbdHWID=record
cb,
idKbd,
usReserved1,
usReserved2:word;
end;
PKbdHWID=^TKbdHWID;
{structure for KbdXlate}
(* #pragma pack(2) ???*)
TKbdTrans=record
chChar:char;
chScan:byte;
fbStatus:byte;
bNlsShift:byte;
fsState:word;
time:longint;
fsDD:word;
fsXlate:word;
fsShift:word;
sZero:word;
end;
PKbdTrans=^TKbdTrans;
{See KR_* constants for FnMask}
function KbdRegister(ModuleName,ProcName:PChar;FnMask:longint):word;
function KbdRegister(ModuleName,ProcName:string;FnMask:longint):word;
{Deregister a keyboard subsystem previously registered within a session - only
the process that issued the KbdRegister may issue KbdDeRegister}
{Possible return codes:
0 NO_ERROR
411 ERROR_KBD_DEREGISTER
464 ERROR_KBD_DETACHED
504 ERROR_KBD_EXTENDED_SG}
function KbdDeRegister:word;
{Return a character data record from the keyboard}
{Key - see TKbdKeyInfo, WaitFlag - see IO_WAIT and IO_NOWAIT constants,
KbdHandle is the default keyboard (0) or a logical keyboard.}
{Possible return codes are:
0 NO_ERROR
375 ERROR_KBD_INVALID_IOWAIT
439 ERROR_KBD_INVALID_HANDLE
445 ERROR_KBD_FOCUS_REQUIRED
447 ERROR_KBD_KEYBOARD_BUSY
464 ERROR_KBD_DETACHED
504 ERROR_KBD_EXTENDED_SG}
{Remarks:
* On an enhanced keyboard, the secondary enter key returns the normal
character 0DH and a scan code of E0H.
* Double-byte character codes (DBCS) require two function calls to obtain the
entire code.
* If shift report is set with KbdSetStatus, the CharData record returned
reflects changed shift information only.
* Extended ASCII codes are identified with the status byte, bit 1 on and the
ASCII character code being either 00H or E0H. Both conditions must be
satisfied for the character to be an extended keystroke. For extended
ASCII codes, the scan code byte returned is the second code (extended
code). Usually the extended ASCII code is the scan code of the primary key
that was pressed.
* A thread in the foreground session that repeatedly polls the keyboard with
KbdCharIn (with no wait), can prevent all regular priority class threads
from executing. If polling must be used and a minimal amount of other
processing is being performed, the thread should periodically yield to the
CPU by issuing a DosSleep call for an interval of at least 5 milliseconds.}
function KbdCharIn(var Key:TKbdKeyInfo;WaitFlag,KbdHandle:word):word;
function KbdPeek(var Key:TKbdKeyInfo;KbdHandle:word):word;
function KbdStringIn(var CharBuf;var pchIn:TStringInBuf;WaitFlag:word;
KbdHandle:word):word;
{Clear the keystroke buffer}
{KbdHandle is the default keyboard (0) or a logical keyboard.}
{Possible return codes are:
0 NO_ERROR
439 ERROR_KBD_INVALID_HANDLE
445 ERROR_KBD_FOCUS_REQUIRED
447 ERROR_KBD_KEYBOARD_BUSY
464 ERROR_KBD_DETACHED
504 ERROR_KBD_EXTENDED_SG}
{Remarks:
* KbdFlushBuffer completes when the handle has access to the physical
keyboard (focus), or is equal to zero and no other handle has the focus.}
function KbdFlushBuffer(KbdHandle:word):word;
function KbdSetStatus(var Status:TKbdInfo;KbdHandle:word):word;
function KbdGetStatus(var Status:TKbdInfo;KbdHandle:word):word;
function KbdSetCp(usReserved,CodePage,KbdHandle:word):word;
{Query the code page being used to translate scan codes to ASCII characters.}
{ulReserved must be set to 0. The keyboard support returns the current code
page for a specified keyboard handle in CodePage, it is one of the code page
IDs specified in the CONFIG.SYS CODEPAGE= statement or 0000. KbdHandle is
the default keyboard (0) or a logical keyboard.}
{Possible return codes:
0 NO_ERROR
373 ERROR_KBD_PARAMETER
439 ERROR_KBD_INVALID_HANDLE
445 ERROR_KBD_FOCUS_REQUIRED
447 ERROR_KBD_KEYBOARD_BUSY
464 ERROR_KBD_DETACHED
504 ERROR_KBD_EXTENDED_SG}
{Remarks:
* CodePage is set to the currently active keyboard code page. A value of 0
indicates the code page translation table in use is the ROM code page
translation table provided by the hardware.}
function KbdGetCp(ulReserved:longint;var CodePage:word;KbdHandle:word):word;
function KbdOpen(var KbdHandle:word):word;
{Close the existing logical keyboard identified by the keyboard handle}
{KbdHandle is the default keyboard (0) or a logical keyboard}
{Possible return codes:
0 NO_ERROR
439 ERROR_KBD_INVALID_HANDLE
464 ERROR_KBD_DETACHED
504 ERROR_KBD_EXTENDED_SG}
{Remarks:
* KbdClose blocks while another thread has the keyboard focus (by way of
KbdGetFocus) until the thread with the focus issues KbdFreeFocus.
Therefore, to prevent KbdClose from blocking, it is recommended that
KbdClose be issued only while the current thread has the focus. For
example:
KbdGetFocus Wait until focus available on handle 0.
KbdClose Close a logical keyboard handle.
KbdFreeFocus Give up the focus on handle 0.}
function KbdClose(KbdHandle:word):word;
{Bind the logical keyboard to the physical keyboard.}
{KbdHandle is the default keyboard (0) or a logical keyboard}
{Possible return codes:
0 NO_ERROR
439 ERROR_KBD_INVALID_HANDLE
445 ERROR_KBD_FOCUS_REQUIRED
464 ERROR_KBD_DETACHED
504 ERROR_KBD_EXTENDED_SG}
function KbdGetFocus(WaitFlag,KbdHandle:word):word;
{Free the logical-to-physical keyboard bond created by KbdGetFocus.}
{KbdHandle is the default keyboard (0) or a logical keyboard}
{Possible return codes:
0 NO_ERROR
439 ERROR_KBD_INVALID_HANDLE
445 ERROR_KBD_FOCUS_REQUIRED
464 ERROR_KBD_DETACHED
504 ERROR_KBD_EXTENDED_SG}
{Remarks:
* KbdFreeFocus may be replaced by issuing KbdRegister. Unlike other keyboard
subsystem functions, the replaced KbdFreeFocus is called only if there is
an outstanding focus.}
function KbdFreeFocus(KbdHandle:word):word;
function KbdSynch (WaitFlag:word):word;
function KbdSetFgnd:word;
function KbdGetHWID(var HWID:TKbdHWID;KbdHandle:word):word;
function KbdSetHWID(var HWID:TKbdHWID;KbdHandle:word):word;
function KbdXlate(var TransData:TKbdTrans;KbdHandle:word):word;
function KbdSetCustXt(var XLateTbl;KbdHandle:word):word;
(* Following routines are not supported
(just have a look in some C header
file - you probably won't find it there either).
KbdInit (index 2)
KbdLoadInstance (index 6)
KbdSwitchFgnd (index 15)
KbdShellInit (index 16)
KbdFree (index 19)
*)
{***************************************************************************}
implementation
{***************************************************************************}
function KbdRegister(ModuleName,ProcName:PChar;FnMask:longint):word;
external 'EMXWRAP' index 208;
{external 'KBDCALLS' index 8;}
function KbdRegister(ModuleName,ProcName:string;FnMask:longint):word;
var A1:array[0..8] of char;
A2:array[0..32] of char;
begin
if byte(ModuleName[0])>8 then byte(ModuleName[0]):=8;
StrPCopy(@A1,ModuleName);
if byte(ProcName[0])>32 then byte(ProcName[0]):=32;
StrPCopy(@A2,ProcName);
KbdRegister:=KbdRegister(@A1,@A2,FnMask);
end;
function KbdDeRegister:word;
external 'EMXWRAP' index 220;
{external 'KBDCALLS' index 20;}
function KbdCharIn(var Key:TKbdKeyInfo;WaitFlag,KbdHandle:word):word;
external 'EMXWRAP' index 204;
{external 'KBDCALLS' index 4;}
function KbdPeek(var Key:TKbdKeyInfo;KbdHandle:word):word;
external 'EMXWRAP' index 222;
{external 'KBDCALLS' index 22;}
function KbdStringIn(var CharBuf;var pchIn:TStringInBuf;WaitFlag:word;
KbdHandle:word):word;
external 'EMXWRAP' index 209;
{external 'KBDCALLS' index 9;}
function KbdFlushBuffer(KbdHandle:word):word;
external 'EMXWRAP' index 213;
{external 'KBDCALLS' index 13;}
function KbdSetStatus(var Status:TKbdInfo;KbdHandle:word):word;
external 'EMXWRAP' index 211;
{external 'KBDCALLS' index 11;}
function KbdGetStatus(var Status:TKbdInfo;KbdHandle:word):word;
external 'EMXWRAP' index 210;
{external 'KBDCALLS' index 10;}
function KbdSetCp(usReserved,CodePage,KbdHandle:word):word;
external 'EMXWRAP' index 205;
{external 'KBDCALLS' index 5;}
function KbdGetCp(ulReserved:longint;var CodePage:word;KbdHandle:word):word;
external 'EMXWRAP' index 203;
{external 'KBDCALLS' index 3;}
function KbdOpen(var KbdHandle:word):word;
external 'EMXWRAP' index 223;
{external 'KBDCALLS' index 23;}
function KbdClose(KbdHandle:word):word;
external 'EMXWRAP' index 217;
{external 'KBDCALLS' index 17;}
function KbdGetFocus(WaitFlag,KbdHandle:word):word;
external 'EMXWRAP' index 212;
{external 'KBDCALLS' index 12;}
function KbdFreeFocus(KbdHandle:word):word;
external 'EMXWRAP' index 218;
{external 'KBDCALLS' index 18;}
function KbdSynch (WaitFlag:word):word;
external 'EMXWRAP' index 207;
{external 'KBDCALLS' index 7;}
function KbdSetFgnd:word;
external 'EMXWRAP' index 221;
{external 'KBDCALLS' index 21;}
function KbdGetHWID(var HWID:TKbdHWID;KbdHandle:word):word;
external 'EMXWRAP' index 224;
{external 'KBDCALLS' index 24;}
function KbdSetHWID(var HWID:TKbdHWID;KbdHandle:word):word;
external 'EMXWRAP' index 225;
{external 'KBDCALLS' index 25;}
function KbdXlate(var TransData:TKbdTrans;KbdHandle:word):word;
external 'EMXWRAP' index 214;
{external 'KBDCALLS' index 14;}
function KbdSetCustXt(var XLateTbl;KbdHandle:word):word;
external 'EMXWRAP' index 201;
{external 'KBDCALLS' index 1;}
end.

1
rtl/os2/mkatx.btm
View File

@ -1 +0,0 @@
ld -o atx prt0.o prt1.o atx.o sysos2.o emx.a dosinit.o

1
rtl/os2/mkcalc_e.btm
View File

@ -1 +0,0 @@
ld -o calc_e prt0.o prt1.o calc_e.o sysos2.o emx.a dosinit.o

1
rtl/os2/mkcrt.btm
View File

@ -1 +0,0 @@
ld -o crtdemo prt0.o prt1.o crtdemo.o sysos2.o crt.o emx.a dosinit.o doscalls.a wrap.a

1
rtl/os2/mkdumpar.btm
View File

@ -1 +0,0 @@
ld -o dumppars prt0.o prt1.o dumppars.o sysos2.o emx.a dosinit.o dos.o strings.o doscalls.a

1
rtl/os2/mkex.btm
View File

@ -1 +0,0 @@
ld -o extest prt0.o prt1.o extest.o dos.o strings.o sysos2.o emx.a dosinit.o doscalls.a wrap.a

1
rtl/os2/mkhello.btm
View File

@ -1 +0,0 @@
ld -o helloos2 prt0.o prt1.o helloos2.o sysos2.o emx.a dosinit.o doscalls.a

1
rtl/os2/mkhsize.btm
View File

@ -1 +0,0 @@
ld -o heapsize prt0.o prt1.o heapsize.o sysos2.o emx.a dosinit.o

1
rtl/os2/mkmode.btm
View File

@ -1 +0,0 @@
ld -o modeinfo prt0.o prt1.o modeinfo.o sysos2.o emx.a dosinit.o wrap.a

66
rtl/os2/modeinfo.pas
View File

@ -1,42 +1,42 @@
program modeinfo;
type viomodeinfo=record
cb:word; { length of the entire data structure }
fbType, { bit mask of mode being set }
color: byte; { number of colors (power of 2) }
col, { number of text columns }
row, { number of text rows }
hres, { horizontal resolution }
vres: word; { vertical resolution }
fmt_ID, { attribute format }
attrib: byte; { number of attributes }
buf_addr,
buf_length,
full_length,
partial_length:longint;
ext_data_addr:pointer;
end;
Pviomodeinfo=^viomodeinfo;
type viomodeinfo=record
cb:word; { length of the entire data structure }
fbType, { bit mask of mode being set }
color: byte; { number of colors (power of 2) }
col, { number of text columns }
row, { number of text rows }
hres, { horizontal resolution }
vres: word; { vertical resolution }
fmt_ID, { attribute format }
attrib: byte; { number of attributes }
buf_addr,
buf_length,
full_length,
partial_length:longint;
ext_data_addr:pointer;
end;
Pviomodeinfo=^viomodeinfo;
function _VioGetMode (var Amodeinfo:viomodeinfo;viohandle:word):word;[C];
function _VioSetMode (var Amodeinfo:viomodeinfo;viohandle:word):word;[C];
var mode:viomodeinfo;
var mode:viomodeinfo;
begin
mode.cb:=sizeof(mode);
writeln('getmode= ',_viogetmode(mode,0));
writeln('cb= ',mode.cb);
writeln('fbtype= ',mode.fbtype);
writeln('color= ',mode.color);
writeln('col= ',mode.col);
writeln('row= ',mode.row);
writeln('hres= ',mode.hres);
writeln('vres= ',mode.vres);
writeln('fmt_ID= ',mode.fmt_ID);
writeln('attrib= ',mode.attrib);
writeln('buf_addr= ',mode.buf_addr);
writeln('buf_length= ',mode.buf_length);
writeln('full_length= ',mode.full_length);
writeln('partial_length= ',mode.partial_length);
mode.cb:=sizeof(mode);
writeln('getmode= ',_viogetmode(mode,0));
writeln('cb= ',mode.cb);
writeln('fbtype= ',mode.fbtype);
writeln('color= ',mode.color);
writeln('col= ',mode.col);
writeln('row= ',mode.row);
writeln('hres= ',mode.hres);
writeln('vres= ',mode.vres);
writeln('fmt_ID= ',mode.fmt_ID);
writeln('attrib= ',mode.attrib);
writeln('buf_addr= ',mode.buf_addr);
writeln('buf_length= ',mode.buf_length);
writeln('full_length= ',mode.full_length);
writeln('partial_length= ',mode.partial_length);
end.

83
rtl/os2/o2rtlb1.pas Normal file
View File

@ -0,0 +1,83 @@
program testread;
{uses crt;}
var
cadena,cadena2 : string;
number : real;
begin
{clrscr;}
cadena2 := 'Previous string';
write ('Enter the string ');
readln (cadena);
writeln ('You entered ',cadena);
writeln ('Previous string was ',cadena2);
write ('Enter a number ');
readln (number);
writeln ('Number entered was ',number);
readln;
end.
{(I have retyped now because my computer is not connected to the net, but I
think that there are no errors).
Now you can do some tests:
1- Compile and run the program as is (that is, using crt). You will find that
a) the program does not erase the screen (that is normal because we have
commented clrscr), but the cursor goes to the first line, thus overwriting the
screen.
b) While the program is expecting the string to be entered, some of the keys
do not work correctly: Backspace advances some spaces (just like tab), tab key
does not work and the cursor keys write garbage. (however this is only in the
screen, because if you have erased a part of the string it will be actually
erased).
c) Once you have press return, the message 'You entered...' appears in the
same line as the text entered.
2- Uncomment the clrscr call, cokpile and execute. Point a of test 1 will be
solved (the screen is erased, so nothing is overwritten), but points b and c
persist.
3- Comment 'uses crt' and 'clrscr'. Now you will not be using crt. Now:
a) Point a of test 1 does not appear: the program begins to write in the
next line, it does not overwrite anything.
b) Now all the keys (tab, backspace..) work as expected.
c) Now the message 'You entered...' appears in the following line, so point
c of test 1 is also solved.
d) BUT it writes only 'You entered', WITHOUT writing the string cadena (!).
It writes also 'Previous string was previous string', so the problem is in
readln and not in writeln.
4- To see if the problem is only in the string vars, uncomment the definition
of number, and also the three lines at the end that deal with number. Now ld
gives the following error message:
testread.pp:0 (testread.o): undefined symbol READ_TEXT_INTEGER referenced from
text segment.
This error happens with 'uses crt' and also without it.
5- Define number as word. Regardless of crt we get the following error from ld:
testread.pp:0 (testread.o): undefined symbol READ_TEXT_WORD referenced from
text segment.
6- Uncomment 'uses crt' if it was commented, and change the definition of
number as real. The program will compile, and it will print the number,
although in the same line as the input.
7- Finally, comment 'uses crt' again. This time it will also compile and link,
but it gives a runtime error!
Laufzeitfehler 106 bei 66422
This error is shown before printing the number.
I expect that these bug report will be useful to debug the RTL. Tonight I will
try to work in the blockwrite problem.
Best regards
Ramon
--
}

2082
rtl/os2/objects.pas Normal file
View File

File diff suppressed because it is too large Load Diff

4
rtl/os2/os.inc
View File

@ -20,8 +20,8 @@
{
$Log$
Revision 1.1 1998-03-25 11:18:46 root
Initial revision
Revision 1.2 1998-04-09 08:24:14 daniel
* Brings OS/2 directory up to date.
Revision 1.3 1998/01/26 12:01:56 michael
+ Added log at the end

4
rtl/os2/os2def.pas
View File

@ -35,7 +35,7 @@ typedef CHAR * _Seg16 PCHAR16; }
{ typedef int ( APIENTRY _PFN) ();
typedef _PFN *PFN;
typedef int ( APIENTRY _NPFN) ();
typedef _NPFN *NPFN; }
typedef _NPFN *NPFN; }
PBYTE = ^BYTE;
NPBYTE = ^BYTE;
@ -346,7 +346,7 @@ typedef _NPFN *NPFN; }
{ null. term. Strings sind in den Header Dateien oft als }
{ array[0..0] of byte deklariert, der folgende Typ er- }
{ m”glich eine Typkonvertierung }
{ m”glich eine Typkonvertierung }
CHARARRAY = array[0..0] of char;
implementation

16
rtl/os2/prt0.as → rtl/os2/prt0.so2
View File

@ -1,6 +1,10 @@
/ prt0.s (emx+fpk) -- Made from crt0.s,
/ Copyright (c) 1990-1994 by Eberhard Mattes.
/ Portions Copyright (c) 1997 Dani‰l Mantione.
/ Changed for FPK-Pascal in 1997 Dani‰l Mantione.
/ This code is _not_ under the Library GNU Public
/ License, because the original is not. See copying.emx
/ for details. You should have received it with this
/ product, write the author if you haven't.
.globl __text
.globl ___syscall
@ -10,15 +14,15 @@
.globl __heap_end
.globl __init
.text
.text
__text:
push $__data
call __dos_init
jmp __init
push $__data
call __dos_init
jmp __init
___syscall:
call __dos_syscall
call __dos_syscall
ret
.space 6, 0x90

38
rtl/os2/prt1.as
View File

@ -1,38 +0,0 @@
/ prt1.s (emx+fpk) -- Made from crt2.s,
/ Copyright (c) 1990-1996 by Eberhard Mattes.
/ Portions Copyright (c) 1997 by Dani‰l Mantione
.globl __entry1
.globl _environ
.globl _envc
.globl _argv
.globl _argc
.text
__entry1:
popl %esi
xorl %ebp, %ebp
leal (%esp), %edi
movl %edi,_environ
call L_ptr_tbl
mov %ecx,_envc
mov %edi,_argv
call L_ptr_tbl
mov %ecx,_argc
jmp *%esi
L_ptr_tbl:
xorl %eax, %eax
movl $-1, %ecx
1: incl %ecx
scasl
jne 1b
ret
.data
.comm _environ, 4
.comm _envc, 4
.comm _argv, 4
.comm _argc, 4

60
rtl/os2/prt1.so2 Normal file
View File

@ -0,0 +1,60 @@
/ prt1.s (emx+fpk) -- Made from crt2.s and dos.s,
/ Copyright (c) 1990-1996 by Eberhard Mattes.
/ Changed for FPK-Pascal in 1997 Dani‰l Mantione.
/ This code is _not_ under the Library GNU Public
/ License, because the original is not. See copying.emx
/ for details. You should have received it with this
/ product, write the author if you haven't.
.globl __entry1
.globl _environ
.globl _envc
.globl _argv
.globl _argc
.text
__entry1:
popl %esi
xorl %ebp, %ebp
leal (%esp), %edi
movl %edi,_environ
call L_ptr_tbl
mov %ecx,_envc
mov %edi,_argv
call L_ptr_tbl
mov %ecx,_argc
jmp *%esi
L_ptr_tbl:
xorl %eax, %eax
movl $-1, %ecx
1: incl %ecx
scasl
jne 1b
ret
/ In executables created with emxbind, the call to _dos_init will
/ be fixed up at load time to _emx_init of emx.dll. Under DOS,
/ this dummy is called instead as there is no fixup. This module
/ must be linked statically to avoid having two fixups for the
/ same location.
.globl __dos_init
.globl __dos_syscall
__dos_init:
ret $4
.align 2, 0x90
__dos_syscall:
int $0x21
ret
.data
.comm _environ, 4
.comm _envc, 4
.comm _argv, 4
.comm _argc, 4

1340
rtl/os2/sysos2.pas
View File

File diff suppressed because it is too large Load Diff

36
rtl/os2/testkbd.pas Normal file
View File

@ -0,0 +1,36 @@
program TestKBD;
{$X+}
uses
{$IFDEF FPK}
KbdCalls;
{$ELSE}
Os2Base, Os2Def;
{$ENDIF}
function ExtKeyPressed: boolean; (* 'key' is here as well e.g. a shift *)
var
C: char;
{$IFDEF VIRTUALPASCAL}
KI: KbdKeyInfo;
K: KbdInfo;
{$ELSE}
KI: TKbdKeyInfo;
K: TKbdInfo;
{$ENDIF}
B: boolean;
begin
B := false;
K.cb := SizeOf (K);
KbdGetStatus (K, 0);
{ FillChar (KI, SizeOf (KI), 0);
KbdCharIn (KI, IO_NOWAIT, 0);}
ExtKeyPressed :=
{ (KI.chScan <> 0) and (KI.chScan and $80 = 0) or }
(K.fsState and $FF0F <> 0);
end;
begin
WriteLn ('Press any _shift_ (or Alt, Ctrl etc.) key to continue ...');
repeat until ExtKeyPressed;
end.