浏览代码

human68k: add an RTL skeleton, almost nothing is implemented yet

Karoly Balogh 1 年之前
父节点
当前提交
c4c3c2a7aa

+ 69 - 0
rtl/human68k/Makefile.fpc

@@ -0,0 +1,69 @@
+#
+#   Makefile.fpc for Free Pascal Human 68k RTL
+#
+
+[package]
+main=rtl
+
+[target]
+loaders=$(LOADERS)
+units=$(SYSTEMUNIT) fpextres $(UUCHARUNIT) $(OBJPASUNIT) $(MACPASUNIT) $(ISO7185UNIT) buildrtl $(CPALLUNIT)
+implicitunits=si_prc $(SYSUTILSUNIT) \
+      $(CTYPESUNIT) $(STRINGSUNIT) $(RTLCONSTSUNIT) $(MATHUNIT) $(TYPESUNIT) \
+      $(TYPINFOUNIT) $(SORTBASEUNIT) $(FGLUNIT) $(CLASSESUNIT) $(CHARSETUNIT) $(CHARACTERUNIT) $(GETOPTSUNIT) $(FPWIDESTRINGUNIT) \
+      $(CP_UNITS) $(UNICODEDATAUNIT) \
+      $(UFLOAT128UNIT) $(UFLOATX80UNIT) $(SFPU128UNIT) $(SFPUX80UNIT) $(SOFTFPUUNIT) 
+
+rsts=$(MATHUNIT) $(RTLCONSTSUNIT) $(TYPINFOUNIT) $(CLASSESUNIT) $(SYSCONSTUNIT)
+
+[require]
+nortl=y
+
+[install]
+fpcpackage=y
+
+[default]
+target=human68k
+cpu=m68k
+
+[compiler]
+includedir=$(INC) $(PROCINC) $(CPU_TARGET)
+sourcedir=$(INC) $(PROCINC) $(CPU_TARGET) $(COMMON)
+
+
+[prerules]
+RTL=..
+INC=$(RTL)/inc
+COMMON=$(RTL)/common
+PROCINC=$(RTL)/$(CPU_TARGET)
+UNITPREFIX=rtl
+LOADERS=
+
+# Paths
+OBJPASDIR=$(RTL)/objpas
+
+[rules]
+.NOTPARALLEL:
+# Get the system independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+
+# Put system unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+
+
+#
+# Base Units (System, strings, os-dependent-base-unit)
+#
+
+buildrtl$(PPUEXT): buildrtl.pp $(SYSTEMUNIT)$(PPUEXT) $(OBJPASUNIT)$(PPUEXT) $(HEAPTRCUNIT)$(PPUEXT)
+        $(COMPILER) -Fi$(OBJPASDIR)/sysutils -Fi$(OBJPASDIR)/classes -Fu$(CPU_TARGET) -Fu$(PROCINC) -Fu$(AMIINC) -I$(INC) -Fu$(INC) -Fu$(OBJPASDIR) buildrtl
+

+ 20 - 0
rtl/human68k/buildrtl.pp

@@ -0,0 +1,20 @@
+unit buildrtl;
+
+  interface
+
+    uses
+{$ifdef cpum68k}
+      si_prc,
+{$endif}
+      sysutils, {dos,}
+
+      ctypes, strings,
+      rtlconsts, sysconst, math, types,
+      typinfo, sortbase, fgl, classes,
+      charset, character, getopts,
+      fpwidestring,
+      softfpu, sfpux80, ufloatx80, sfpu128, ufloat128;
+
+  implementation
+
+end.

+ 70 - 0
rtl/human68k/classes.pp

@@ -0,0 +1,70 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2016 by the Free Pascal development team
+
+    Classes unit for Human 68k
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program 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.
+
+ **********************************************************************}
+
+{$mode objfpc}
+{$H+}
+{$modeswitch advancedrecords}
+{$IF FPC_FULLVERSION>=30301}
+{$modeswitch FUNCTIONREFERENCES}
+{$define FPC_HAS_REFERENCE_PROCEDURE}
+{$endif}
+
+{ determine the type of the resource/form file }
+{$define Win16Res}
+
+{$IFNDEF FPC_DOTTEDUNITS}
+unit Classes;
+{$ENDIF FPC_DOTTEDUNITS}
+
+interface
+
+{$IFDEF FPC_DOTTEDUNITS}
+uses
+  System.SysUtils,
+  System.RtlConsts,
+  System.Types,
+  System.SortBase,
+{$ifdef FPC_TESTGENERICS}
+  System.FGL,
+{$endif}
+  System.TypInfo;
+{$ELSE FPC_DOTTEDUNITS}
+uses
+  sysutils,
+  rtlconsts,
+  types,
+  sortbase,
+{$ifdef FPC_TESTGENERICS}
+  fgl,
+{$endif}
+  typinfo;
+{$ENDIF FPC_DOTTEDUNITS}
+
+{$i classesh.inc}
+
+
+implementation
+
+{ OS - independent class implementations are in /inc directory. }
+{$i classes.inc}
+
+
+initialization
+  CommonInit;
+
+finalization
+  CommonCleanup;
+
+end.

+ 4 - 0
rtl/human68k/rtl.cfg

@@ -0,0 +1,4 @@
+# Some optional features for the Human 68k (Sharp X68000)
+
+# Can be disabled to reduce binary sizes.
+#-SfNOUNICODESTRINGS

+ 24 - 0
rtl/human68k/rtldefs.inc

@@ -0,0 +1,24 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2012 by Free Pascal development team
+
+    This file contains platform-specific defines that are used in
+    multiple RTL units.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program 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.
+
+ **********************************************************************}
+
+{ the single byte OS APIs always use UTF-8 }
+{ define FPCRTL_FILESYSTEM_UTF8}
+
+{ The OS supports a single byte file system operations API that we use }
+{$define FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
+
+{ The OS supports a two byte file system operations API that we use }
+{ define FPCRTL_FILESYSTEM_TWO_BYTE_API}

+ 37 - 0
rtl/human68k/sysdir.inc

@@ -0,0 +1,37 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2020 by Free Pascal development team
+
+    Low level directory functions for Human 68k (Sharp X68000)
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program 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.
+
+ **********************************************************************}
+
+
+{*****************************************************************************
+                           Directory Handling
+*****************************************************************************}
+procedure do_mkdir(const s : rawbytestring);
+begin
+end;
+
+
+procedure do_rmdir(const s : rawbytestring);
+begin
+end;
+
+
+procedure do_ChDir(const s: rawbytestring);
+begin
+end;
+
+
+procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
+begin
+end;

+ 94 - 0
rtl/human68k/sysfile.inc

@@ -0,0 +1,94 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2023 by Free Pascal development team
+
+    Low level file functions for Human 68k (Sharp X68000)
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program 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.
+
+ **********************************************************************}
+
+
+{****************************************************************************
+                        Low level File Routines
+               All these functions can set InOutRes on errors
+****************************************************************************}
+
+{ close a file from the handle value }
+procedure do_close(handle : longint);
+begin
+end;
+
+
+procedure do_erase(p : pchar; pchangeable: boolean);
+begin
+end;
+
+
+procedure do_rename(p1,p2 : pchar; p1changeable, p2changeable: boolean);
+begin
+end;
+
+
+function do_write(h: longint; addr: pointer; len: longint) : longint;
+begin
+  do_write:=-1;
+end;
+
+
+function do_read(h: longint; addr: pointer; len: longint) : longint;
+begin
+  do_read:=-1;
+end;
+
+
+function do_filepos(handle: longint) : longint;
+begin
+  do_filepos:=-1;
+end;
+
+
+procedure do_seek(handle, pos: longint);
+begin
+end;
+
+
+function do_seekend(handle: longint):longint;
+begin
+  do_seekend:=-1;
+end;
+
+
+function do_filesize(handle : THandle) : longint;
+begin
+  do_filesize:=-1;
+end;
+
+
+{ truncate at a given position }
+procedure do_truncate(handle, pos: longint);
+begin
+end;
+
+
+procedure do_open(var f;p:pchar;flags:longint; pchangeable: boolean);
+{
+  filerec and textrec have both handle and mode as the first items so
+  they could use the same routine for opening/creating.
+  when (flags and $100)   the file will be append
+  when (flags and $1000)  the file will be truncate/rewritten
+  when (flags and $10000) there is no check for close (needed for textfiles)
+}
+begin
+end;
+
+
+function do_isdevice(handle: thandle): boolean;
+begin
+  do_isdevice:=false;
+end;

+ 29 - 0
rtl/human68k/sysheap.inc

@@ -0,0 +1,29 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2005 by Free Pascal development team
+
+    Low level memory functions
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program 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.
+
+ **********************************************************************}
+
+{*****************************************************************************
+      OS Memory allocation / deallocation
+ ****************************************************************************}
+
+
+function SysOSAlloc(size: ptruint): pointer;
+begin
+end;
+
+{$define HAS_SYSOSFREE}
+
+procedure SysOSFree(p: pointer; size: ptruint);
+begin
+end;

+ 20 - 0
rtl/human68k/sysos.inc

@@ -0,0 +1,20 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    This file implements all the base types and limits required
+    for a minimal POSIX compliant subset required to port the compiler
+    to a new OS.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program 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.
+
+ **********************************************************************}
+
+procedure Error2InOutRes(errno: longint);
+begin
+end;

+ 34 - 0
rtl/human68k/sysosh.inc

@@ -0,0 +1,34 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    This file implements all the base types and limits required
+    for a minimal POSIX compliant subset required to port the compiler
+    to a new OS.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program 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.
+
+ **********************************************************************}
+
+{Platform specific information}
+type
+{$ifdef CPU64}
+  THandle = Int64;
+{$else CPU64}
+  THandle = Longint;
+{$endif CPU64}
+  TThreadID = THandle;
+  TOSTimestamp = Longint;
+
+  PRTLCriticalSection = ^TRTLCriticalSection;
+  TRTLCriticalSection = record
+   Locked: boolean
+  end;
+
+
+

+ 187 - 0
rtl/human68k/system.pp

@@ -0,0 +1,187 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2023 by Karoly Balogh
+
+    System unit for the Human 68k (Sharp X68000)
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program 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.
+
+ **********************************************************************}
+unit System;
+
+interface
+
+{$define FPC_IS_SYSTEM}
+{$define FPC_STDOUT_TRUE_ALIAS}
+{$define FPC_ANSI_TEXTFILEREC}
+{$define FPC_HUMAN68K_USE_TINYHEAP}
+
+{$ifdef FPC_HUMAN68K_USE_TINYHEAP}
+{$define HAS_MEMORYMANAGER}
+{$endif FPC_HUMAN68K_USE_TINYHEAP}
+
+{$i systemh.inc}
+{$ifdef FPC_HUMAN68K_USE_TINYHEAP}
+{$i tnyheaph.inc}
+{$endif FPC_HUMAN68K_USE_TINYHEAP}
+
+{Platform specific information}
+const
+    LineEnding = #13#10;
+    LFNSupport = false;
+    CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
+    DirectorySeparator = '\';
+    DriveSeparator = ':';
+    ExtensionSeparator = '.';
+    PathSeparator = ';';
+    AllowDirectorySeparators : set of char = ['\','/'];
+    AllowDriveSeparators : set of char = [':'];
+    FileNameCaseSensitive = false;
+    FileNameCasePreserving = false;
+    maxExitCode = 255;
+    MaxPathLen = 255;
+    AllFilesMask = '*.*';
+
+    sLineBreak = LineEnding;
+    DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
+
+const
+    UnusedHandle    = -1;
+    StdInputHandle: longint = UnusedHandle;
+    StdOutputHandle: longint = UnusedHandle;
+    StdErrorHandle: longint = UnusedHandle;
+
+var
+    args: PChar;
+    argc: LongInt;
+    argv: PPChar;
+    envp: PPChar;
+
+
+    {$if defined(FPUSOFT)}
+
+    {$define fpc_softfpu_interface}
+    {$i softfpu.pp}
+    {$undef fpc_softfpu_interface}
+
+    {$endif defined(FPUSOFT)}
+
+
+  implementation
+
+    {$if defined(FPUSOFT)}
+
+    {$define fpc_softfpu_implementation}
+    {$define softfpu_compiler_mul32to64}
+    {$define softfpu_inline}
+    {$i softfpu.pp}
+    {$undef fpc_softfpu_implementation}
+
+    { we get these functions and types from the softfpu code }
+    {$define FPC_SYSTEM_HAS_float64}
+    {$define FPC_SYSTEM_HAS_float32}
+    {$define FPC_SYSTEM_HAS_flag}
+    {$define FPC_SYSTEM_HAS_extractFloat64Frac0}
+    {$define FPC_SYSTEM_HAS_extractFloat64Frac1}
+    {$define FPC_SYSTEM_HAS_extractFloat64Exp}
+    {$define FPC_SYSTEM_HAS_extractFloat64Sign}
+    {$define FPC_SYSTEM_HAS_ExtractFloat32Frac}
+    {$define FPC_SYSTEM_HAS_extractFloat32Exp}
+    {$define FPC_SYSTEM_HAS_extractFloat32Sign}
+
+    {$endif defined(FPUSOFT)}
+
+    {$i system.inc}
+    {$ifdef FPC_HUMAN68K_USE_TINYHEAP}
+    {$i tinyheap.inc}
+    {$endif FPC_HUMAN68K_USE_TINYHEAP}
+
+
+  function GetProcessID:SizeUInt;
+  begin
+    GetProcessID := 1;
+  end;
+
+
+{*****************************************************************************
+                             ParamStr
+*****************************************************************************}
+
+{ number of args }
+function ParamCount: LongInt;
+begin
+  ParamCount:=0;
+end;
+
+{ argument number l }
+function ParamStr(l: LongInt): shortstring;
+begin
+  ParamStr:='';
+end;
+
+procedure SysInitParamsAndEnv;
+begin
+end;
+
+
+  procedure randomize;
+  begin
+    {$WARNING: randseed is uninitialized}
+    randseed:=0;
+  end;
+
+{*****************************************************************************
+                         System Dependent Exit code
+*****************************************************************************}
+procedure system_exit;
+begin
+end;
+
+{*****************************************************************************
+                         System Unit Initialization
+*****************************************************************************}
+
+procedure SysInitStdIO;
+begin
+  OpenStdIO(Input,fmInput,StdInputHandle);
+  OpenStdIO(Output,fmOutput,StdOutputHandle);
+  OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
+{$ifndef FPC_STDOUT_TRUE_ALIAS}
+  OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+  OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+{$endif FPC_STDOUT_TRUE_ALIAS}
+end;
+
+function CheckInitialStkLen (StkLen: SizeUInt): SizeUInt;
+begin
+  CheckInitialStkLen := StkLen;
+end;
+
+
+begin
+  StackLength := CheckInitialStkLen (InitialStkLen);
+{ Initialize ExitProc }
+  ExitProc:=Nil;
+{$ifndef FPC_HUMAN68K_USE_TINYHEAP}
+{ Setup heap }
+  InitHeap;
+{$endif FPC_HUMAN68K_USE_TINYHEAP}
+  SysInitExceptions;
+{$ifdef FPC_HAS_FEATURE_UNICODESTRINGS}
+  InitUnicodeStringManager;
+{$endif FPC_HAS_FEATURE_UNICODESTRINGS}
+{ Setup stdin, stdout and stderr }
+  SysInitStdIO;
+{ Reset IO Error }
+  InOutRes:=0;
+{ Setup command line arguments }
+  SysInitParamsAndEnv;
+{$ifdef FPC_HAS_FEATURE_THREADING}
+  InitSystemThreads;
+{$endif FPC_HAS_FEATURE_THREADING}
+end.

+ 483 - 0
rtl/human68k/sysutils.pp

@@ -0,0 +1,483 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2023 by Free Pascal development team
+
+    Sysutils unit for Human 68k (Sharp X68000)
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program 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.
+
+ **********************************************************************}
+
+{$IFNDEF FPC_DOTTEDUNITS}
+unit sysutils;
+{$ENDIF FPC_DOTTEDUNITS}
+
+interface
+
+{$MODE objfpc}
+{$MODESWITCH OUT}
+{ force ansistrings }
+{$H+}
+{$modeswitch typehelpers}
+{$modeswitch advancedrecords}
+
+{$DEFINE OS_FILESETDATEBYNAME}
+{$DEFINE HAS_SLEEP}
+{$DEFINE HAS_OSERROR}
+
+{OS has only 1 byte version for ExecuteProcess}
+{$define executeprocuni}
+
+{ used OS file system APIs use ansistring }
+{$define SYSUTILS_HAS_ANSISTR_FILEUTIL_IMPL}
+{ OS has an ansistring/single byte environment variable API }
+{$define SYSUTILS_HAS_ANSISTR_ENVVAR_IMPL}
+
+{ Include platform independent interface part }
+{$i sysutilh.inc}
+
+{ Platform dependent calls }
+
+
+implementation
+
+{$IFDEF FPC_DOTTEDUNITS}
+uses
+  System.SysConst;
+{$ELSE FPC_DOTTEDUNITS}
+uses
+  sysconst;
+{$ENDIF FPC_DOTTEDUNITS}
+
+{$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
+{$DEFINE FPC_FEXPAND_DRIVES} (* Full paths begin with drive specification *)
+
+{ Include platform independent implementation part }
+{$i sysutils.inc}
+
+{****************************************************************************
+                              File Functions
+****************************************************************************}
+{$I-}{ Required for correct usage of these routines }
+
+
+(****** non portable routines ******)
+
+function FileOpen(const FileName: rawbytestring; Mode: Integer): THandle;
+begin
+  FileOpen:=-1;
+  if FileOpen < -1 then
+    FileOpen:=-1;
+end;
+
+
+function FileGetDate(Handle: THandle) : Int64;
+begin
+  result:=-1;
+end;
+
+
+function FileSetDate(Handle: THandle; Age: Int64) : LongInt;
+begin
+  result:=0;
+end;
+
+
+function FileSetDate(const FileName: RawByteString; Age: Int64) : LongInt;
+var
+  f: THandle;
+begin
+  result:=-1;
+  f:=FileOpen(FileName,fmOpenReadWrite);
+  if f < 0 then
+    exit;
+  result:=FileSetDate(f,Age);
+  FileClose(f);
+end;
+
+
+function FileCreate(const FileName: RawByteString) : THandle;
+begin
+  FileCreate:=-1;
+  if FileCreate < -1 then
+    FileCreate:=-1;
+end;
+
+function FileCreate(const FileName: RawByteString; Rights: integer): THandle;
+begin
+  { FIX ME: we map this to FileCreate(), and ignore rights! }
+  FileCreate:=FileCreate(FileName);
+end;
+
+function FileCreate(const FileName: RawByteString; ShareMode: integer; Rights : integer): THandle;
+begin
+  { FIX ME: we map this to FileCreate(), and ignore rights and sharemode! }
+  FileCreate:=FileCreate(FileName);
+end;
+
+
+function FileRead(Handle: THandle; out Buffer; Count: LongInt): LongInt;
+begin
+  FileRead:=-1;
+  if (Count<=0) then
+    exit;
+
+  FileRead:=-1;
+  if FileRead < -1 then
+    FileRead:=-1;
+end;
+
+
+function FileWrite(Handle: THandle; const Buffer; Count: LongInt): LongInt;
+begin
+  FileWrite:=-1;
+  if (Count<=0) then 
+    exit;
+
+  FileWrite:=-1;
+  if FileWrite < -1 then
+    FileWrite:=-1;
+end;
+
+
+function FileSeek(Handle: THandle; FOffset, Origin: LongInt) : LongInt;
+var
+  dosResult: longint;
+begin
+  FileSeek:=-1;
+
+  dosResult:=-1;
+  if dosResult < 0 then
+    exit;
+
+  FileSeek:=dosResult;
+end;
+
+function FileSeek(Handle: THandle; FOffset: Int64; Origin: Longint): Int64;
+begin
+  FileSeek:=FileSeek(Handle,LongInt(FOffset),Origin);
+end;
+
+
+procedure FileClose(Handle: THandle);
+begin
+end;
+
+
+function FileTruncate(Handle: THandle; Size: Int64): Boolean;
+begin
+  FileTruncate:=False;
+end;
+
+
+function DeleteFile(const FileName: RawByteString) : Boolean;
+begin
+  DeleteFile:=false;
+end;
+
+
+function RenameFile(const OldName, NewName: RawByteString): Boolean;
+begin
+  RenameFile:=false;
+end;
+
+
+
+(****** end of non portable routines ******)
+
+
+function FileAge (const FileName : RawByteString): Int64;
+var
+  f: THandle;
+begin
+  FileAge:=-1;
+  f:=FileOpen(FileName,fmOpenRead);
+  if f < 0 then
+    exit;
+  FileAge:=FileGetDate(f);
+  FileClose(f);
+end;
+
+
+function FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
+begin
+  Result := False;
+end;
+
+
+function FileExists (const FileName : RawByteString; FollowLink : Boolean) : Boolean;
+var
+  Attr: longint;
+begin
+  FileExists:=false;
+  Attr:=FileGetAttr(FileName);
+  if Attr < 0 then
+    exit;
+
+  result:=(Attr and (faVolumeID or faDirectory)) = 0;
+end;
+
+
+Function InternalFindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name: RawByteString) : Longint;
+var
+  dosResult: longint;
+begin
+  result:=-1; { We emulate Linux/Unix behaviour, and return -1 on errors. }
+
+  Rslt.FindHandle:=-1;
+  dosResult:=-1; { add findfirst here }
+  if dosResult < 0 then
+    begin
+      InternalFindClose(Rslt.FindHandle);
+      exit;
+    end;
+
+  Rslt.FindHandle:=-1;
+
+  Name:='';
+  SetCodePage(Name,DefaultFileSystemCodePage,false);
+
+  Rslt.Time:=0;
+  Rslt.Size:=0;
+
+  { "128" is Windows "NORMALFILE" attribute. Some buggy code depend on this... :( (KB) }
+  Rslt.Attr := 128 or 0;
+
+  result:=0;
+end;
+
+
+Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : RawByteString) : Longint;
+var
+  dosResult: longint;
+begin
+  result:=-1;
+
+  dosResult:=-1;
+  if dosResult < 0 then
+    exit;
+
+  Name:='';
+  SetCodePage(Name,DefaultFileSystemCodePage,false);
+
+  Rslt.Time:=0;
+  Rslt.Size:=0;
+
+  { "128" is Windows "NORMALFILE" attribute. Some buggy code depend on this... :( (KB) }
+  Rslt.Attr := 128 or 0;
+
+  result:=0;
+end;
+
+
+Procedure InternalFindClose(var Handle: Longint);
+begin
+end;
+
+
+(****** end of non portable routines ******)
+
+Function FileGetAttr (Const FileName : RawByteString) : Longint;
+begin
+  FileGetAttr:=0;
+end;
+
+
+Function FileSetAttr (Const Filename : RawByteString; Attr: longint) : Longint;
+begin
+  FileSetAttr:=-1;
+
+  if FileSetAttr < -1 then
+    FileSetAttr:=-1
+  else
+    FileSetAttr:=0;
+end;
+
+
+
+{****************************************************************************
+                              Disk Functions
+****************************************************************************}
+
+function DiskSize(Drive: Byte): Int64;
+var
+  dosResult: longint;
+begin
+  DiskSize := -1;
+
+  dosResult:=-1;
+  if dosResult < 0 then
+    exit;
+
+  DiskSize:=0;
+end;
+
+function DiskFree(Drive: Byte): Int64;
+var
+  dosResult: longint;
+begin
+  DiskFree := -1;
+
+  dosResult:=-1;
+  if dosResult < 0 then
+    exit;
+
+  DiskFree:=0;
+end;
+
+function DirectoryExists(const Directory: RawByteString; FollowLink : Boolean): Boolean;
+var
+  Attr: longint;
+begin
+  DirectoryExists:=false;
+  Attr:=FileGetAttr(Directory);
+  if Attr < 0 then
+    exit;
+
+  result:=(Attr and faDirectory) <> 0;
+end;
+
+
+
+{****************************************************************************
+                              Locale Functions
+****************************************************************************}
+
+Procedure GetLocalTime(var SystemTime: TSystemTime);
+begin
+   DateTimeToSystemTime(FileDateToDateTime(0),SystemTime);
+end;
+
+
+Procedure InitAnsi;
+Var
+  i : longint;
+begin
+  {  Fill table entries 0 to 127  }
+  for i := 0 to 96 do
+    UpperCaseTable[i] := chr(i);
+  for i := 97 to 122 do
+    UpperCaseTable[i] := chr(i - 32);
+  for i := 123 to 191 do
+    UpperCaseTable[i] := chr(i);
+  Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+
+  for i := 0 to 64 do
+    LowerCaseTable[i] := chr(i);
+  for i := 65 to 90 do
+    LowerCaseTable[i] := chr(i + 32);
+  for i := 91 to 191 do
+    LowerCaseTable[i] := chr(i);
+  Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+end;
+
+
+Procedure InitInternational;
+begin
+  InitInternationalGeneric;
+  InitAnsi;
+end;
+
+function SysErrorMessage(ErrorCode: Integer): String;
+begin
+  Result:=Format(SUnknownErrorCode,[ErrorCode]);
+end;
+
+function GetLastOSError: Integer;
+begin
+  result:=-1;
+end;
+
+{****************************************************************************
+                              OS utility functions
+****************************************************************************}
+
+function GetPathString: String;
+begin
+  {writeln('Unimplemented GetPathString');}
+  result := '';
+end;
+
+Function GetEnvironmentVariable(Const EnvVar : String) : String;
+begin
+  {writeln('Unimplemented GetEnvironmentVariable');}
+  result:='';
+end;
+
+Function GetEnvironmentVariableCount : Integer;
+begin
+  {writeln('Unimplemented GetEnvironmentVariableCount');}
+  result:=0;
+end;
+
+Function GetEnvironmentString(Index : Integer) : {$ifdef FPC_RTL_UNICODE}UnicodeString{$else}AnsiString{$endif};
+begin
+  {writeln('Unimplemented GetEnvironmentString');}
+  result:='';
+end;
+
+function ExecuteProcess (const Path: RawByteString; const ComLine: RawByteString;Flags:TExecuteFlags=[]):
+                                                                       integer;
+var
+  tmpPath: RawByteString;
+  pcmdline: ShortString;
+  CommandLine: RawByteString;
+  E: EOSError;
+begin
+  tmpPath:=ToSingleByteFileSystemEncodedFileName(Path);
+  pcmdline:=ToSingleByteFileSystemEncodedFileName(ComLine);
+
+  result:=-1; { execute here }
+
+  if result < 0 then begin
+    if ComLine = '' then
+      CommandLine := Path
+    else
+      CommandLine := Path + ' ' + ComLine;
+
+    E := EOSError.CreateFmt (SExecuteProcessFailed, [CommandLine, result]);
+    E.ErrorCode := result;
+    raise E;
+  end;
+end;
+
+function ExecuteProcess (const Path: RawByteString;
+                                  const ComLine: array of RawByteString;Flags:TExecuteFlags=[]): integer;
+var
+  CommandLine: RawByteString;
+  I: integer;
+
+begin
+  Commandline := '';
+  for I := 0 to High (ComLine) do
+   if Pos (' ', ComLine [I]) <> 0 then
+    CommandLine := CommandLine + ' ' + '"' + ToSingleByteFileSystemEncodedFileName(ComLine [I]) + '"'
+   else
+    CommandLine := CommandLine + ' ' + ToSingleByteFileSystemEncodedFileName(Comline [I]);
+  ExecuteProcess := ExecuteProcess (Path, CommandLine);
+end;
+
+procedure Sleep(Milliseconds: cardinal);
+begin
+  {writeln('Unimplemented sleep');}
+end;
+
+
+{****************************************************************************
+                              Initialization code
+****************************************************************************}
+
+Initialization
+  InitExceptions;
+  InitInternational;    { Initialize internationalization settings }
+  OnBeep:=Nil;          { No SysBeep() on Human 68k for now }
+
+Finalization
+  FreeTerminateProcs;
+  DoneExceptions;
+end.

+ 80 - 0
rtl/human68k/tthread.inc

@@ -0,0 +1,80 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program 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.
+
+ **********************************************************************}
+{****************************************************************************}
+{*                             TThread                                      *}
+{****************************************************************************}
+
+
+procedure TThread.CallOnTerminate;
+
+begin
+end;
+
+
+function TThread.GetPriority: TThreadPriority;
+
+begin
+  GetPriority:=tpNormal;
+end;
+
+
+procedure TThread.SetPriority(Value: TThreadPriority);
+
+begin
+end;
+
+
+procedure TThread.SetSuspended(Value: Boolean);
+
+begin
+end;
+
+
+procedure TThread.DoTerminate;
+
+begin
+end;
+
+
+procedure TThread.SysCreate(CreateSuspended: Boolean; const StackSize: SizeUInt);
+
+begin
+ {IsMultiThread := TRUE; }
+end;
+
+
+procedure TThread.SysDestroy;
+
+begin
+end;
+
+
+procedure TThread.Resume;
+
+begin
+end;
+
+
+procedure TThread.Suspend;
+
+begin
+end;
+
+
+function TThread.WaitFor: Integer;
+
+begin
+  WaitFor:=0;
+end;
+
+