paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-05 17:30:49 +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

1
rtl/os2/bind.btm
View File

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

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

196
rtl/os2/crt.pas
View File

@ -127,21 +127,32 @@ type Tkbdkeyinfo=record
{EMXWRAP.DLL has strange calling conventions: All parameters must have
a 4 byte size.}
function _KbdCharIn(var Akeyrec:Tkbdkeyinfo;wait,kbdhandle:longint):word;[C];
function _KbdPeek(var Akeyrec:TkbdkeyInfo;kbdhandle:word):word;[C];
function kbdcharin(var Akeyrec:Tkbdkeyinfo;wait,kbdhandle:longint):word;
external 'EMXWRAP' index 204;
function kbdpeek(var Akeyrec:TkbdkeyInfo;kbdhandle:word):word;
external 'EMXWRAP' index 222;
function _DosSleep(time:longint):word;[C];
function _VioScrollUp(top,left,bottom,right,lines:longint;
var screl:word;viohandle:longint):word;[C];
function _VioScrollDn(top,left,bottom,right,lines:longint;
var screl:word;viohandle:longint):word;[C];
function _VioGetCurPos(var row,column:word;viohandle:longint):word;[C];
function _VioSetCurPos(row,column,viohandle:longint):word;[C];
function _VioWrtTTY(s:Pchar;len,viohandle:longint):word;[C];
function _VioWrtCharStrAtt(var s:char;len,row,col:longint;var attr:byte;
viohandle:longint):word;[C];
function _VioGetMode (var Amodeinfo:viomodeinfo;viohandle:longint):word;[C];
function _VioSetMode (var Amodeinfo:viomodeinfo;viohandle:longint):word;[C];
function dossleep(time:longint):word;
external 'DOSCALLS' index 229;
function vioscrollup(top,left,bottom,right,lines:longint;
var screl:word;viohandle:longint):word;
external 'EMXWRAP' index 107;
function vioscrolldn(top,left,bottom,right,lines:longint;
var screl:word;viohandle:longint):word;
external 'EMXWRAP' index 147;
function viogetcurpos(var row,column:word;viohandle:longint):word;
external 'EMXWRAP' index 109;
function viosetcurpos(row,column,viohandle:longint):word;
external 'EMXWRAP' index 115;
function viowrtTTY(s:Pchar;len,viohandle:longint):word;
external 'EMXWRAP' index 119;
function viowrtcharstratt(s:Pchar;len,row,col:longint;var attr:byte;
viohandle:longint):word;
external 'EMXWRAP' index 148;
function viogetmode(var Amodeinfo:viomodeinfo;viohandle:longint):word;
external 'EMXWRAP' index 121;
function viosetmode(var Amodeinfo:viomodeinfo;viohandle:longint):word;
external 'EMXWRAP' index 122;
procedure setscreenmode(mode:word);
@ -161,7 +172,7 @@ begin
newmode.color:=4; {We want 16 colours, 2^4=16.}
newmode.col:=modecols[mode and 15];
newmode.row:=moderows[mode shr 4];
if _viosetmode(newmode,0)=0 then
if viosetmode(newmode,0)=0 then
crt_error:=cenoerror
else
crt_error:=cemodeset;
@ -232,7 +243,7 @@ procedure getcursor(var y,x:word);
begin
if os_mode=osOS2 then
_viogetcurpos(y,x,0)
viogetcurpos(y,x,0)
else
asm
movb $3,%ah
@ -251,7 +262,7 @@ procedure setcursor(y,x:word);
begin
if os_mode=osOS2 then
_viosetcurpos(y,x,0)
viosetcurpos(y,x,0)
else
asm
movb $2,%ah
@ -266,7 +277,7 @@ procedure scroll_up(top,left,bottom,right,lines:word;var screl:word);
begin
if os_mode=osOS2 then
_vioscrollup(top,left,bottom,right,lines,screl,0)
vioscrollup(top,left,bottom,right,lines,screl,0)
else
asm
movb $6,%ah
@ -285,7 +296,7 @@ procedure scroll_dn(top,left,bottom,right,lines:word;var screl:word);
begin
if os_mode=osOS2 then
_vioscrolldn(top,left,bottom,right,lines,screl,0)
vioscrolldn(top,left,bottom,right,lines,screl,0)
else
asm
movb $7,%ah
@ -309,7 +320,7 @@ var Akeyrec:Tkbdkeyinfo;
begin
if os_mode=osOS2 then
begin
_kbdpeek(Akeyrec,0);
kbdpeek(Akeyrec,0);
keypressed:=(extkeycode<>#0) or ((Akeyrec.fbstatus and $40)<>0);
end
else
@ -346,9 +357,11 @@ begin
begin
if os_mode=osOS2 then
begin
_kbdcharin(Akeyrec,0,0);
kbdcharin(Akeyrec,0,0);
c:=Akeyrec.charcode;
s:=Akeyrec.scancode;
if (c=#224) and (s<>#0) then
c:=#0;
end
else
begin
@ -515,7 +528,7 @@ begin
unreliable, because OS/2 can hold our programs while calibrating,
if it needs the processor for other things.}
if os_mode=osOS2 then
_dossleep(ms)
dossleep(ms)
else
begin
for i:=1 to ms do
@ -550,19 +563,22 @@ procedure writePchar(s:Pchar;len:word);
var x,y:word;
c:char;
i:integer;
i,n:integer;
screl:word;
ca:Pchar;
begin
for i:=0 to len-1 do
begin
i:=0;
getcursor(y,x);
while i<=len-1 do
begin
case s[i] of
#8:
x:=(x-lo(windmin)) and $fff8+8;
x:=x-1;
#9:
x:=(x-lo(windmin)) and $fff8+8+lo(windmin);
#10:
begin
end;
;
#13:
begin
x:=lo(windmin);
@ -570,20 +586,30 @@ begin
end;
else
begin
ca:=@s[i];
n:=1;
while not(s[i+1] in [#8,#9,#10,#13]) and
(x+n<=lo(windmax)+1) and (i<len-1) do
begin
inc(n);
inc(i);
end;
if os_mode=osOS2 then
_viowrtcharstratt(s[i],1,y,x,textattr,0)
viowrtcharstratt(ca,n,y,x,textattr,0)
else
asm
movl s,%eax
movswl i,%ebx
movb (%eax,%ebx),%al
movb $9,%ah
movw $0x1300,%ax
movb $0,%bh
movb U_CRT_TEXTATTR,%bl
movw $1,%cx
movb y,%dh
movb x,%dl
movw n,%cx
pushl %ebp
movl ca,%ebp
int $0x10
popl %ebp
end;
inc(x);
x:=x+n;
end;
end;
if x>lo(windmax) then
@ -599,11 +625,13 @@ begin
1,screl);
y:=hi(windmax);
end;
setcursor(y,x);
{ writeln(stderr,x,' ',y);}
inc(i);
end;
setcursor(y,x);
end;
function crtread(var f:text):word;
function crtread(var f:textrec):word;
{Read a series of characters from the console.}
@ -612,11 +640,13 @@ var max,curpos,i:integer;
clist:array[0..2] of char;
begin
max:=textrec(f).bufsize-2;
max:=f.bufsize-2;
curpos:=0;
repeat
c:=readkey;
case c of
#0:
readkey;
#8:
if curpos>0 then
begin
@ -626,18 +656,20 @@ begin
end;
#13:
begin
textrec(f).bufptr^[curpos]:=#13;
f.bufptr^[curpos]:=#13;
inc(curpos);
textrec(f).bufptr^[curpos]:=#10;
f.bufptr^[curpos]:=#10;
inc(curpos);
textrec(f).bufpos:=0;
textrec(f).bufend:=curpos;
f.bufpos:=0;
f.bufend:=curpos;
clist[0]:=#13;
writePchar(@clist,1);
break;
end;
#32..#255:
if curpos<max then
begin
textrec(f).bufptr^[curpos]:=c;
f.bufptr^[curpos]:=c;
inc(curpos);
writePchar(@c,1);
end;
@ -646,49 +678,42 @@ begin
crtread:=0;
end;
function crtwrite(var f:text):word;
function crtwrite(var f:textrec):word;
{Write a series of characters to the console.}
begin
writePchar(Pchar(textrec(f).bufptr),textrec(f).bufpos);
textrec(f).bufpos:=0;
writePchar(Pchar(f.bufptr),f.bufpos);
f.bufpos:=0;
crtwrite:=0;
end;
function crtreturn(var f:text):word;
{Dummy: return zero.}
function crtopen(var f:textrec):integer;
begin
crtreturn:=0;
if f.mode=fmoutput then
crtopen:=0
else
crtopen:=5;
end;
function crtopen(var f:text):word;
{Opens a file that is assigned to the crt console.}
var inout,flush,close:pointer;
function crtinout(var f:textrec):integer;
begin
if textrec(f).mode=fminput then
begin
inout:=@crtread;
flush:=@crtreturn;
close:=@crtreturn;
end
else
begin
textrec(f).mode:=fmoutput;
inout:=@crtwrite;
flush:=@crtwrite;
close:=@crtreturn;
case f.mode of
fminput:
crtinout:=crtread(f);
fmoutput:
crtinout:=crtwrite(f);
end;
end;
textrec(f).inoutfunc:=inout;
textrec(f).flushfunc:=flush;
textrec(f).closefunc:=close;
crtopen:=0;
function crtclose(var f:textrec):integer;
begin
f.mode:=fmclosed;
crtclose:=0;
end;
procedure assigncrt(var f:text);
@ -699,7 +724,13 @@ begin
textrec(f).mode:=fmclosed;
textrec(f).bufsize:=128;
textrec(f).bufptr:=@textrec(f).buffer;
textrec(f).bufpos:=0;
textrec(f).openfunc:=@crtopen;
textrec(f).inoutfunc:=@crtinout;
textrec(f).flushfunc:=@crtinout;
textrec(f).closefunc:=@crtclose;
textrec(f).name[0]:='.';
textrec(f).name[0]:=#0;
end;
procedure sound(hz:word);
@ -720,7 +751,7 @@ function get_ticks:word;
type Pword=^word;
begin
get_ticks:=Pword(longint(first_page)+$46c)^;
get_ticks:=Pword(longint(first_meg)+$46c)^;
end;
procedure initdelay;
@ -776,7 +807,7 @@ begin
if os_mode=osOS2 then
begin
curmode.cb:=sizeof(curmode);
_viogetmode(curmode,0);
viogetmode(curmode,0);
maxcols:=curmode.col;
maxrows:=curmode.row;
lastmode:=0;
@ -791,11 +822,11 @@ begin
case maxrows of
25:;
28:
inc(lastmode,16);
lastmode:=lastmode+16;
43:
inc(lastmode,32);
lastmode:=lastmode+32;
50:
inc(lastmode,48);
lastmode:=lastmode+48;
end
end
else
@ -819,23 +850,24 @@ begin
end;
end;
{Get number of rows from realmode $0040:$0084.}
maxrows:=Pbyte(longint(first_page)+$484)^;
maxrows:=Pbyte(longint(first_meg)+$484)^;
case maxrows of
25:;
28:
inc(lastmode,16);
lastmode:=lastmode+16;
43:
inc(lastmode,32);
lastmode:=lastmode+32;
50:
inc(lastmode,48);
lastmode:=lastmode+48;
end
end;
window(1,1,maxcols,maxrows);
windmin:=0;
windmax:=((maxrows-1) shl 8) or (maxcols-1);
if os_mode=osDOS then
initdelay;
crt_error:=cenoerror;
assigncrt(input);
reset(Input);
textrec(input).mode:=fminput;
assigncrt(output);
rewrite(output);
textrec(output).mode:=fmoutput;
end.

12
rtl/os2/crtdemo.pas
View File

@ -69,13 +69,13 @@ begin
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 ',
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 }
LastRow:=lastrow-80 div LastCol; { don't write on message line }
Randomize; { init random number generator }
end; { Init }

25
rtl/os2/dos.pas
View File

@ -35,6 +35,8 @@
OS/2 support added.
12 june 1997:
OS/2 port done.
12 November 1997:
Adapted to new DLL stuff.
}
unit dos;
@ -234,8 +236,9 @@ unit dos;
cbsector:word;
end;
function _DosQueryFSInfo(driveno:word;infolevel:word;
var info;infolen:word):word;[C];
function dosqueryFSinfo(driveno:word;infolevel:word;
var info;infolen:word):word;
external 'DOSCALLS' index 278;
{$endif OS2}
@ -464,9 +467,8 @@ unit dos;
type bytearray=array[0..8191] of byte;
Pbytearray=^bytearray;
{ replaced by pbyte that works on smallset an normal set
setarray=array[0..31] of byte; by (PM) }
pbyte = ^byte;
setarray=array[0..3] of byte;
execstruc=record
argofs,envofs,nameofs:pointer;
@ -556,8 +558,7 @@ unit dos;
es.sizearg:=j;
es.numenv:=0;
{Typecasting of sets in FPK is a bit hard.}
{ this way works allways (PM) }
es.mode1:=pbyte(@runflags)^;
es.mode1:=setarray(runflags)[0];
es.mode2:=byte(winflags);
{Now exec the program.}
@ -896,7 +897,7 @@ unit dos;
else
{In OS/2, we use the filesystem information.}
begin
doserror:=_dosqueryFSinfo(drive,1,FI,sizeof(FI));
doserror:=dosqueryFSinfo(drive,1,FI,sizeof(FI));
if doserror=0 then
diskfree:=FI.cunitavail*FI.csectorunit*FI.cbsector
else
@ -1218,16 +1219,20 @@ unit dos;
end;
var
{$IFDEF DOS}
s,pa : string[79];
{$ELSE}
s,pa:string;
{$ENDIF}
begin
{ There are differences between FPKPascal and Turbo Pascal
e.g. for the string 'D:\DEMO\..\HELLO' which isn't handled }
getdir(0,s);
pa:=upcase(path);
if (ord(pa[0])>1) and (((pa[1]>='A') and (pa[1]<='Z')) and (pa[2]=':')) then
if (byte(pa[0])>1) and ((pa[1] in ['A'..'Z']) and (pa[2]=':')) then
begin
if (ord(pa[0])>2) and (pa[3]<>'\') then
if (byte(pa[0])>2) and (pa[3]<>'\') then
if pa[1]=s[1] then
pa:=s+'\'+copy (pa,3,length(pa))
else

2926
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

3
rtl/os2/helloos2.pas
View File

@ -12,10 +12,13 @@ begin
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

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

6
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

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

1182
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.