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

* cleanup and changes to use new includes

Browse Source
This commit is contained in:
Károly Balogh 2004-06-13 22:50:47 +00:00
parent 8e7885f368
commit 706397f557
2 changed files with 67 additions and 208 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
rtl/morphos/dos.pp
View File

@ -1,11 +1,14 @@
{ {
$Id$ $Id$
This file is part of the Free Pascal run time library. This file is part of the Free Pascal run time library.
Copyright (c) 2004 by Karoly Balogh for Genesi Sarl Copyright (c) 2004 by Karoly Balogh for Genesi S.a.r.l.
Heavily based on the Amiga/m68k RTL by Nils Sjoholm and Heavily based on the Commodore Amiga/m68k RTL by Nils Sjoholm and
Carl Eric Codere Carl Eric Codere
MorphOS port was done on a free Pegasos II/G4 machine
provided by Genesi S.a.r.l. <www.genesi.lu>
See the file COPYING.FPC, included in this distribution, See the file COPYING.FPC, included in this distribution,
for details about the copyright. for details about the copyright.
@ -161,6 +164,11 @@ Procedure Keep(exitcode: word);
implementation implementation
{ * include MorphOS specific functions & definitions * }
{$include execd.inc}
{$include execf.inc}
const const
DaysPerMonth : Array[1..12] of ShortInt = DaysPerMonth : Array[1..12] of ShortInt =
(031,028,031,030,031,030,031,031,030,031,030,031); (031,028,031,030,031,030,031,031,030,031,030,031);
@ -399,12 +407,9 @@ Type
Const Const
{ IO_COMMAND to use for adding a timer } { IO_COMMAND to use for adding a timer }
CMD_NONSTD = 9;
TR_ADDREQUEST = CMD_NONSTD; TR_ADDREQUEST = CMD_NONSTD;
TR_GETSYSTIME = CMD_NONSTD + 1; TR_GETSYSTIME = CMD_NONSTD + 1;
TR_SETSYSTIME = CMD_NONSTD + 2; TR_SETSYSTIME = CMD_NONSTD + 2;
MEMF_PUBLIC = %000000000000000000000001;
MEMF_CLEAR = %000000010000000000000000;
{ To use any of the routines below, TimerBase must be set to point { To use any of the routines below, TimerBase must be set to point
to the timer.device, either by calling CreateTimer or by pulling to the timer.device, either by calling CreateTimer or by pulling
@ -436,7 +441,7 @@ begin
IOReq := NIL; IOReq := NIL;
if port <> NIL then if port <> NIL then
begin begin
IOReq := exec_AllocMem(size, MEMF_CLEAR or MEMF_PUBLIC); IOReq := AllocMem2(size, MEMF_CLEAR or MEMF_PUBLIC);
if IOReq <> NIL then if IOReq <> NIL then
begin begin
IOReq^.io_Message.mn_Node.ln_Type := 7; IOReq^.io_Message.mn_Node.ln_Type := 7;
@ -454,7 +459,7 @@ begin
ioReq^.io_Message.mn_Node.ln_Type := $FF; ioReq^.io_Message.mn_Node.ln_Type := $FF;
ioReq^.io_Message.mn_ReplyPort := pMsgPort(-1); ioReq^.io_Message.mn_ReplyPort := pMsgPort(-1);
ioReq^.io_Device := pDevice(-1); ioReq^.io_Device := pDevice(-1);
exec_FreeMem(ioReq, ioReq^.io_Message.mn_Length); FreeMem2(ioReq, ioReq^.io_Message.mn_Length);
end end
end; end;
@ -463,11 +468,11 @@ var
sigbit : ShortInt; sigbit : ShortInt;
port : pMsgPort; port : pMsgPort;
begin begin
sigbit := exec_AllocSignal(-1); sigbit := AllocSignal(-1);
if sigbit = -1 then CreatePort := nil; if sigbit = -1 then CreatePort := nil;
port := exec_Allocmem(sizeof(tMsgPort),MEMF_CLEAR or MEMF_PUBLIC); port := AllocMem2(sizeof(tMsgPort),MEMF_CLEAR or MEMF_PUBLIC);
if port = nil then begin if port = nil then begin
exec_FreeSignal(sigbit); FreeSignal(sigbit);
CreatePort := nil; CreatePort := nil;
end; end;
with port^ do begin with port^ do begin
@ -478,9 +483,9 @@ begin
mp_Node.ln_Type := 4; mp_Node.ln_Type := 4;
mp_Flags := 0; mp_Flags := 0;
mp_SigBit := sigbit; mp_SigBit := sigbit;
mp_SigTask := exec_FindTask(nil); mp_SigTask := FindTask(nil);
end; end;
if assigned(name) then exec_AddPort(port) if assigned(name) then AddPort(port)
else NewList(addr(port^.mp_MsgList)); else NewList(addr(port^.mp_MsgList));
CreatePort := port; CreatePort := port;
end; end;
@ -490,12 +495,12 @@ begin
if port <> NIL then if port <> NIL then
begin begin
if port^.mp_Node.ln_Name <> NIL then if port^.mp_Node.ln_Name <> NIL then
exec_RemPort(port); RemPort(port);
port^.mp_Node.ln_Type := $FF; port^.mp_Node.ln_Type := $FF;
port^.mp_MsgList.lh_Head := pNode(-1); port^.mp_MsgList.lh_Head := pNode(-1);
exec_FreeSignal(port^.mp_SigBit); FreeSignal(port^.mp_SigBit);
exec_FreeMem(port, sizeof(tMsgPort)); FreeMem2(port, sizeof(tMsgPort));
end; end;
end; end;
@ -514,7 +519,7 @@ begin
DeletePort(TimerPort); DeletePort(TimerPort);
Create_Timer := Nil; Create_Timer := Nil;
end; end;
Error := exec_OpenDevice(TIMERNAME, theUnit, pIORequest(TimeReq), 0); Error := OpenDevice(TIMERNAME, theUnit, pIORequest(TimeReq), 0);
if Error <> 0 then begin if Error <> 0 then begin
DeleteExtIO(pIORequest(TimeReq)); DeleteExtIO(pIORequest(TimeReq));
DeletePort(TimerPort); DeletePort(TimerPort);
@ -531,7 +536,7 @@ begin
WhichPort := WhichTimer^.tr_Node.io_Message.mn_ReplyPort; WhichPort := WhichTimer^.tr_Node.io_Message.mn_ReplyPort;
if assigned(WhichTimer) then begin if assigned(WhichTimer) then begin
exec_CloseDevice(pIORequest(WhichTimer)); CloseDevice(pIORequest(WhichTimer));
DeleteExtIO(pIORequest(WhichTimer)); DeleteExtIO(pIORequest(WhichTimer));
end; end;
if assigned(WhichPort) then if assigned(WhichPort) then
@ -550,7 +555,7 @@ begin
tr^.tr_time.tv_secs := secs; tr^.tr_time.tv_secs := secs;
tr^.tr_time.tv_micro := micro; tr^.tr_time.tv_micro := micro;
tr^.tr_node.io_Command := TR_SETSYSTIME; tr^.tr_node.io_Command := TR_SETSYSTIME;
exec_DoIO(pIORequest(tr)); DoIO(pIORequest(tr));
delete_timer(tr); delete_timer(tr);
set_new_time := 0; set_new_time := 0;
@ -566,7 +571,7 @@ begin
if tr = nil then get_sys_time := -1; if tr = nil then get_sys_time := -1;
tr^.tr_node.io_Command := TR_GETSYSTIME; tr^.tr_node.io_Command := TR_GETSYSTIME;
exec_DoIO(pIORequest(tr)); DoIO(pIORequest(tr));
{ structure assignment } { structure assignment }
tv^ := tr^.tr_time; tv^ := tr^.tr_time;
@ -766,7 +771,7 @@ Var
Begin Begin
Free := -1; Free := -1;
{ Here we stop systemrequesters to appear } { Here we stop systemrequesters to appear }
myproc := pProcess(exec_FindTask(nil)); myproc := pProcess(FindTask(nil));
OldWinPtr := myproc^.pr_WindowPtr; OldWinPtr := myproc^.pr_WindowPtr;
myproc^.pr_WindowPtr := Pointer(-1); myproc^.pr_WindowPtr := Pointer(-1);
{ End of systemrequesterstop } { End of systemrequesterstop }
@ -797,7 +802,7 @@ Var
Begin Begin
Size := -1; Size := -1;
{ Here we stop systemrequesters to appear } { Here we stop systemrequesters to appear }
myproc := pProcess(exec_FindTask(nil)); myproc := pProcess(FindTask(nil));
OldWinPtr := myproc^.pr_WindowPtr; OldWinPtr := myproc^.pr_WindowPtr;
myproc^.pr_WindowPtr := Pointer(-1); myproc^.pr_WindowPtr := Pointer(-1);
{ End of systemrequesterstop } { End of systemrequesterstop }
@ -1369,7 +1374,10 @@ End.
{ {
$Log$ $Log$
Revision 1.4 2004-05-16 00:24:19 karoly Revision 1.5 2004-06-13 22:51:08 karoly
* cleanup and changes to use new includes
Revision 1.4 2004/05/16 00:24:19 karoly
* some cleanup * some cleanup
Revision 1.3 2004/05/13 00:48:52 karoly Revision 1.3 2004/05/13 00:48:52 karoly

223
rtl/morphos/system.pp
View File

@ -58,6 +58,8 @@ const
MorphOS structures MorphOS structures
*****************************************************************************} *****************************************************************************}
{$include execd.inc}
type type
PClockData = ^TClockData; PClockData = ^TClockData;
TClockData = packed Record TClockData = packed Record
@ -95,79 +97,6 @@ type
fib_Reserved : Array [0..35] of Char; fib_Reserved : Array [0..35] of Char;
end; end;
PNode = ^TNode;
TNode = packed record
ln_Succ, { Pointer to next (successor) }
ln_Pred: pNode; { Pointer to previous (predecessor) }
ln_Type: Byte;
ln_Pri : Shortint; { Priority, for sorting }
ln_Name: PChar; { ID string, null terminated }
end; { Note: Integer aligned }
PMinNode = ^TMinNode;
tMinNode = packed record
mln_Succ,
mln_Pred: pMinNode;
end;
PList = ^TList;
tList = packed record
lh_Head : pNode;
lh_Tail : pNode;
lh_TailPred: pNode;
lh_Type : Byte;
l_pad : Byte;
end;
PMinList = ^TMinList;
TMinList = packed record
mlh_Head : PMinNode;
mlh_Tail : PMinNode;
mlh_TailPred: PMinNode;
end;
PMsgPort = ^TMsgPort;
TMsgPort = packed record
mp_Node : TNode;
mp_Flags : Byte;
mp_SigBit : Byte; { signal bit number }
mp_SigTask: Pointer; { task to be signalled (TaskPtr) }
mp_MsgList: TList; { message linked list }
end;
PMessage = ^TMessage;
TMessage = packed record
mn_Node : TNode;
mn_ReplyPort: PMsgPort;
mn_Length : Word;
end;
PTask = ^TTask;
TTask = packed record
tc_Node : TNode;
tc_Flags : Byte;
tc_State : Byte;
tc_IDNestCnt : Shortint; { intr disabled nesting }
tc_TDNestCnt : Shortint; { task disabled nesting }
tc_SigAlloc : DWord; { sigs allocated }
tc_SigWait : DWord; { sigs we are waiting for }
tc_SigRecvd : DWord; { sigs we have received }
tc_SigExcept : DWord; { sigs we will take excepts for }
tc_TrapAlloc : Word; { traps allocated }
tc_TrapAble : Word; { traps enabled }
tc_ExceptData: Pointer; { points to except data }
tc_ExceptCode: Pointer; { points to except code }
tc_TrapData : Pointer; { points to trap data }
tc_TrapCode : Pointer; { points to trap code }
tc_SPReg : Pointer; { stack pointer }
tc_SPLower : Pointer; { stack lower bound }
tc_SPUpper : Pointer; { stack upper bound + 2 }
tc_Switch : Pointer; { task losing CPU }
tc_Launch : Pointer; { task getting CPU }
tc_MemEntry : TList; { allocated memory }
tc_UserData : Pointer; { per task data }
end;
PProcess = ^TProcess; PProcess = ^TProcess;
TProcess = packed record TProcess = packed record
pr_Task : TTask; pr_Task : TTask;
@ -199,44 +128,6 @@ type
pr_CES : DWord; { Error stream - IF NULL, use pr_COS } pr_CES : DWord; { Error stream - IF NULL, use pr_COS }
end; end;
PLibrary = ^TLibrary;
TLibrary = packed record
lib_Node : tNode;
lib_Flags,
lib_pad : Byte;
lib_NegSize, { number of bytes before library }
lib_PosSize, { number of bytes after library }
lib_Version, { major }
lib_Revision: Word; { minor }
lib_IdString: PChar; { ASCII identification }
lib_Sum : LongInt; { the checksum itself }
lib_OpenCnt : Word; { number of current opens }
end; { * Warning: size is not a longword multiple ! * }
PDevice = ^TDevice;
tDevice = packed record
dd_Library: TLibrary;
end;
PUnit = ^tUnit;
TUnit = packed record
unit_MsgPort: TMsgPort; { queue for unprocessed messages }
{ instance of msgport is recommended }
unit_flags,
unit_pad : Byte;
unit_OpenCnt: Word; { number of active opens }
end;
PIORequest = ^TIORequest;
TIORequest = packed record
io_Message: TMessage;
io_Device : PDevice; { device node pointer }
io_Unit : PUnit; { unit (driver private)}
io_Command: Word; { device command }
io_Flags : Byte;
io_Error : Shortint; { error or warning num }
end;
PInfoData = ^TInfoData; PInfoData = ^TInfoData;
TInfoData = packed record TInfoData = packed record
id_NumSoftErrors: LongInt; { number of soft errors on disk } id_NumSoftErrors: LongInt; { number of soft errors on disk }
@ -304,43 +195,6 @@ var
MorphOS functions MorphOS functions
*****************************************************************************} *****************************************************************************}
{ exec.library functions }
function exec_OpenLibrary(libname: PChar location 'a1';
libver: LongInt location 'd0'): Pointer; SysCall MOS_ExecBase 552;
procedure exec_CloseLibrary(libhandle: Pointer location 'a1'); SysCall MOS_ExecBase 414;
function exec_CreatePool(memflags: LongInt location 'd0';
puddleSize: LongInt location 'd1';
threshSize: LongInt location 'd2'): Pointer; SysCall MOS_ExecBase 696;
procedure exec_DeletePool(poolHeader: Pointer location 'a0'); SysCall MOS_ExecBase 702;
function exec_AllocPooled(poolHeader: Pointer location 'a0';
memSize: LongInt location 'd0'): Pointer; SysCall MOS_ExecBase 708;
function exec_SetSignal(newSignals: LongInt location 'd0';
signalMask: LongInt location 'd1'): LongInt; SysCall MOS_ExecBase 306;
function exec_FindTask(tname: PChar location 'a1'): PTask; SysCall MOS_ExecBase 294;
function exec_GetMsg(port: PMsgPort location 'a0'): PMessage; SysCall MOS_ExecBase 372;
function exec_WaitPort(port: PMsgPort location 'a0'): PMessage; SysCall MOS_ExecBase 384;
function exec_AllocMem(byteSize: LongInt location 'd0';
requirements: LongInt location 'd1'): Pointer; SysCall MOS_ExecBase 198;
procedure exec_FreeMem(memoryBlock: Pointer location 'a1';
byteSize: LongInt location 'd0'); SysCall MOS_ExecBase 210;
function exec_AllocSignal(signalNum: LongInt location 'd0'): ShortInt; SysCall MOS_ExecBase 330;
procedure exec_FreeSignal(signalNum: LongInt location 'd0'); SysCall MOS_ExecBase 336;
procedure exec_AddPort(port: PMsgPort location 'a1'); SysCall MOS_ExecBase 354;
procedure exec_RemPort(port: PMsgPort location 'a1'); SysCall MOS_ExecBase 360;
function exec_DoIO(ioRequest: PIORequest location 'a1'): ShortInt; SysCall MOS_ExecBase 456;
function exec_OpenDevice(const devName: PChar location 'a0';
unite: LongInt location 'd0';
ioRequest: PIORequest location 'a1';
flags: LongInt location 'd1'): ShortInt; SysCall MOS_ExecBase 444;
procedure exec_CloseDevice(ioRequest: PIORequest location 'a1'); SysCall MOS_ExecBase 450;
{ dos.library functions } { dos.library functions }
function dos_Output: LongInt; SysCall MOS_DOSBase 60; function dos_Output: LongInt; SysCall MOS_DOSBase 60;
@ -427,10 +281,21 @@ implementation
{$I system.inc} {$I system.inc}
{*****************************************************************************
MorphOS functions
*****************************************************************************}
{ exec.library functions }
{$include execf.inc}
{***************************************************************************** {*****************************************************************************
System Dependent Structures/Consts System Dependent Structures/Consts
*****************************************************************************} *****************************************************************************}
{ Errors from dos_IoErr(), etc. } { Errors from dos_IoErr(), etc. }
const const
ERROR_NO_FREE_STORE = 103; ERROR_NO_FREE_STORE = 103;
@ -493,23 +358,6 @@ const
EXCLUSIVE_LOCK = -1; EXCLUSIVE_LOCK = -1;
ACCESS_WRITE = EXCLUSIVE_LOCK; ACCESS_WRITE = EXCLUSIVE_LOCK;
{ Memory flags }
const
MEMF_ANY = 0;
MEMF_PUBLIC = 1 Shl 0;
MEMF_CHIP = 1 Shl 1;
MEMF_FAST = 1 Shl 2;
MEMF_LOCAL = 1 Shl 8;
MEMF_24BITDMA = 1 Shl 9;
MEMF_KICK = 1 Shl 10;
MEMF_CLEAR = 1 Shl 16;
MEMF_LARGEST = 1 Shl 17;
MEMF_REVERSE = 1 Shl 18;
MEMF_TOTAL = 1 Shl 19;
MEMF_NO_EXPUNGE = 1 Shl 31;
const const
CTRL_C = 20; { Error code on CTRL-C press } CTRL_C = 20; { Error code on CTRL-C press }
SIGBREAKF_CTRL_C = $1000; { CTRL-C signal flags } SIGBREAKF_CTRL_C = $1000; { CTRL-C signal flags }
@ -620,16 +468,16 @@ begin
{ may call I/O routines, which in turn might call } { may call I/O routines, which in turn might call }
{ halt, so a recursive stack crash } { halt, so a recursive stack crash }
if BreakOn then begin if BreakOn then begin
if (exec_SetSignal(0,0) and SIGBREAKF_CTRL_C)<>0 then if (SetSignal(0,0) and SIGBREAKF_CTRL_C)<>0 then
exec_SetSignal(0,SIGBREAKF_CTRL_C); SetSignal(0,SIGBREAKF_CTRL_C);
end; end;
{ Closing opened files } { Closing opened files }
CloseList(MOS_fileList); CloseList(MOS_fileList);
if MOS_UtilityBase<>nil then exec_CloseLibrary(MOS_UtilityBase); if MOS_UtilityBase<>nil then CloseLibrary(MOS_UtilityBase);
if MOS_DOSBase<>nil then exec_CloseLibrary(MOS_DOSBase); if MOS_DOSBase<>nil then CloseLibrary(MOS_DOSBase);
if MOS_heapPool<>nil then exec_DeletePool(MOS_heapPool); if MOS_heapPool<>nil then DeletePool(MOS_heapPool);
haltproc(ExitCode); haltproc(ExitCode);
end; end;
@ -683,9 +531,9 @@ end;
procedure checkCTRLC; procedure checkCTRLC;
begin begin
if BreakOn then begin if BreakOn then begin
if (exec_SetSignal(0,0) And SIGBREAKF_CTRL_C)<>0 then begin if (SetSignal(0,0) And SIGBREAKF_CTRL_C)<>0 then begin
{ Clear CTRL-C signal } { Clear CTRL-C signal }
exec_SetSignal(0,SIGBREAKF_CTRL_C); SetSignal(0,SIGBREAKF_CTRL_C);
Halt(CTRL_C); Halt(CTRL_C);
end; end;
end; end;
@ -865,7 +713,7 @@ end;
{ must return the first address of new data space or nil if fail } { must return the first address of new data space or nil if fail }
function Sbrk(size : longint):pointer; function Sbrk(size : longint):pointer;
begin begin
Sbrk:=exec_AllocPooled(MOS_heapPool,size); Sbrk:=AllocPooled(MOS_heapPool,size);
end; end;
{$I heap.inc} {$I heap.inc}
@ -1240,32 +1088,32 @@ end;
procedure SysInitMorphOS; procedure SysInitMorphOS;
var self: PProcess; var self: PProcess;
begin begin
self:=PProcess(exec_FindTask(nil)); self:=PProcess(FindTask(nil));
if self^.pr_CLI=0 then begin if self^.pr_CLI=0 then begin
{ if we're running from Ambient/Workbench, we catch its message } { if we're running from Ambient/Workbench, we catch its message }
exec_WaitPort(@self^.pr_MsgPort); WaitPort(@self^.pr_MsgPort);
MOS_ambMsg:=exec_GetMsg(@self^.pr_MsgPort); MOS_ambMsg:=GetMsg(@self^.pr_MsgPort);
end; end;
MOS_DOSBase:=exec_OpenLibrary('dos.library',50); MOS_DOSBase:=OpenLibrary('dos.library',50);
if MOS_DOSBase=nil then Halt(1); if MOS_DOSBase=nil then Halt(1);
MOS_UtilityBase:=exec_OpenLibrary('utility.library',50); MOS_UtilityBase:=OpenLibrary('utility.library',50);
if MOS_UtilityBase=nil then Halt(1); if MOS_UtilityBase=nil then Halt(1);
{ Creating the memory pool for growing heap } { Creating the memory pool for growing heap }
MOS_heapPool:=exec_CreatePool(MEMF_FAST,growheapsize2,growheapsize1); MOS_heapPool:=CreatePool(MEMF_FAST,growheapsize2,growheapsize1);
if MOS_heapPool=nil then Halt(1); if MOS_heapPool=nil then Halt(1);
if MOS_ambMsg=nil then begin if MOS_ambMsg=nil then begin
StdInputHandle:=dos_Input; StdInputHandle:=dos_Input;
StdOutputHandle:=dos_Output; StdOutputHandle:=dos_Output;
end else begin end else begin
MOS_ConHandle:=dos_Open(MOS_ConName,1005); MOS_ConHandle:=dos_Open(MOS_ConName,1005);
if MOS_ConHandle<>0 then begin if MOS_ConHandle<>0 then begin
StdInputHandle:=MOS_ConHandle; StdInputHandle:=MOS_ConHandle;
StdOutputHandle:=MOS_ConHandle; StdOutputHandle:=MOS_ConHandle;
end else end else
Halt(1); Halt(1);
end; end;
end; end;
@ -1314,7 +1162,10 @@ end.
{ {
$Log$ $Log$
Revision 1.12 2004-06-06 23:31:13 karoly Revision 1.13 2004-06-13 22:50:47 karoly
* cleanup and changes to use new includes
Revision 1.12 2004/06/06 23:31:13 karoly
* fixed dos_UnLockDosList from being nonsense, and some cleanup * fixed dos_UnLockDosList from being nonsense, and some cleanup
Revision 1.11 2004/06/06 19:18:05 karoly Revision 1.11 2004/06/06 19:18:05 karoly