* z80-embedded rtl skeleton continued

git-svn-id: branches/z80@35712 -

.gitattributes

@@ -10150,6 +10150,9 @@ rtl/x86_64/strings.inc svneol=native#text/plain
 rtl/x86_64/stringss.inc svneol=native#text/plain
 rtl/x86_64/x86_64.inc svneol=native#text/plain
 rtl/z80/makefile.cpu svneol=native#text/plain
+rtl/z80/setjump.inc svneol=native#text/plain
+rtl/z80/setjumph.inc svneol=native#text/plain
+rtl/z80/z80.inc svneol=native#text/plain
 tests/MPWMake -text
 tests/Makefile svneol=native#text/plain
 tests/Makefile.fpc svneol=native#text/plain

rtl/embedded/rtl.cfg

@@ -115,3 +115,12 @@
 -SfCLASSES
 -SfRTTI
 #endif
+
+# does not require extra memory, neither code nor data
+# in programs not using e. g. writeln based I/O which is the common case
+#ifdef CPUZ80
+-SfOBJECTS
+-SfEXCEPTIONS
+-SfCLASSES
+-SfRTTI
+#endif

rtl/inc/heaph.inc

@@ -56,20 +56,20 @@ procedure SetMemoryManager(const MemMgr: TMemoryManager);
 function  IsMemoryManagerSet: Boolean;
 
 { Variables }
-const
-  MaxKeptOSChunks: DWord = 4; { if more than MaxKeptOSChunks are free, the heap manager will release
-                              chunks back to the OS }
-  growheapsizesmall : ptruint=32*1024; { fixed-size small blocks will grow with 32k }
-  growheapsize1 : ptruint=256*1024;  { < 256k will grow with 256k }
-  growheapsize2 : ptruint=1024*1024; { > 256k will grow with 1m }
 var
   ReturnNilIfGrowHeapFails : boolean;
-
 {$ifdef EMBEDDED}
   {$define FPC_NO_DEFAULT_MEMORYMANAGER}
 {$endif EMBEDDED}
 
 {$ifndef FPC_NO_DEFAULT_MEMORYMANAGER}
+const
+  MaxKeptOSChunks: DWord = 4; { if more than MaxKeptOSChunks are free, the heap manager will release
+                              chunks back to the OS }
+  growheapsizesmall : ptruint=32*1024; { fixed-size small blocks will grow with 32k }
+  growheapsize1 : ptruint=256*1024;  { < 256k will grow with 256k }
+  growheapsize2 : ptruint=1024*1024; { > 256k will grow with 1m }
+
 { Default MemoryManager functions }
 Function  SysGetmem(Size:ptruint):Pointer;
 Function  SysFreemem(p:pointer):ptruint;

rtl/inc/system.inc

@@ -301,6 +301,14 @@ function do_isdevice(handle:thandle):boolean;forward;
   {$define SYSPROCDEFINED}
 {$endif cpuaarch64}
 
+{$ifdef cpuz80}
+  {$ifdef SYSPROCDEFINED}
+    {$Error Can't determine processor type !}
+  {$endif}
+  {$i z80.inc}  { Case dependent, don't change }
+  {$define SYSPROCDEFINED}
+{$endif cpuz80}
+
 {$ifndef SYSPROCDEFINED}
   {$Error Can't determine processor type !}
 {$endif}

rtl/z80/setjump.inc

@@ -0,0 +1,26 @@
+{
+
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2008 by the Free Pascal development team.
+
+    SetJmp and LongJmp implementation for exception handling
+
+    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.
+
+ **********************************************************************}
+
+function fpc_setjmp(var S : jmp_buf) : shortint;assembler;[Public, alias : 'FPC_SETJMP'];nostackframe;compilerproc;
+  asm
+  end;
+
+
+procedure fpc_longjmp(var S : jmp_buf;value : shortint);assembler;[Public, alias : 'FPC_LONGJMP'];compilerproc;
+  asm
+  end;
+
+

rtl/z80/setjumph.inc

@@ -0,0 +1,26 @@
+{
+
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2008 by the Free Pascal development team.
+
+    SetJmp/Longjmp declarations
+
+    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.
+
+ **********************************************************************}
+
+type
+   jmp_buf = packed record
+     f,a,b,c,e,d,l,h,ixlo,ixhi,iylo,iyhi,splo,sphi,pclo,pchi : byte;
+   end;
+   pjmp_buf = ^jmp_buf;
+
+function setjmp(var S : jmp_buf) : shortint;[external name 'FPC_SETJMP'];
+procedure longjmp(var S : jmp_buf;value : shortint);[external name 'FPC_LONGJMP'];
+
+

rtl/z80/z80.inc

@@ -0,0 +1,271 @@
+{
+
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2017 by the Free Pascal development team.
+
+    Processor dependent implementation for the system unit for
+    Z80
+
+    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 fpc_cpuinit;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+  end;
+
+
+{$define FPC_SYSTEM_HAS_MOVE}
+procedure Move(const source;var dest;count:SizeInt);[public, alias: 'FPC_MOVE'];
+var
+  pdest,psrc,pend : pbyte;
+begin
+  if (@dest=@source) or (count<=0) then
+    exit;
+  if (@dest<@source) or (@source+count<@dest) then
+    begin
+      { Forward Move }
+      psrc:=@source;
+      pdest:=@dest;
+      pend:=psrc+count;
+      while psrc<pend do
+        begin
+          pdest^:=psrc^;
+          inc(pdest);
+          inc(psrc);
+        end;
+    end
+  else
+    begin
+      { Backward Move }
+      psrc:=@source+count;
+      pdest:=@dest+count;
+      while psrc>@source do
+        begin
+          dec(pdest);
+          dec(psrc);
+          pdest^:=psrc^;
+        end;
+    end;
+end;
+
+
+{$define FPC_SYSTEM_HAS_FILLCHAR}
+Procedure FillChar(var x;count:SizeInt;value:byte);
+var
+  pdest,pend : pbyte;
+  v : ptruint;
+begin
+  if count <= 0 then
+    exit;
+  pdest:=@x;
+  pend:=pdest+count;
+  while pdest<pend do
+    begin
+      pdest^:=value;
+      inc(pdest);
+    end;
+end;
+
+
+{$IFNDEF INTERNAL_BACKTRACE}
+{$define FPC_SYSTEM_HAS_GET_FRAME}
+function get_frame:pointer;assembler;nostackframe;
+  asm
+  end;
+{$ENDIF not INTERNAL_BACKTRACE}
+
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
+function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;assembler;
+  asm
+  end;
+
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
+function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;assembler;
+  asm
+  end;
+
+
+{$define FPC_SYSTEM_HAS_SPTR}
+Function Sptr : pointer;assembler;
+  asm
+  end;
+
+
+function InterLockedDecrement (var Target: longint) : longint;
+  var
+    temp_sreg : byte;
+  begin
+    { block interrupts }
+    asm
+    end;
+
+    dec(Target);
+    Result:=Target;
+
+    { release interrupts }
+    asm
+    end;
+  end;
+
+
+function InterLockedIncrement (var Target: longint) : longint;
+  var
+    temp_sreg : byte;
+  begin
+    { block interrupts }
+    asm
+    end;
+
+    inc(Target);
+    Result:=Target;
+
+    { release interrupts }
+    asm
+    end;
+  end;
+
+
+function InterLockedExchange (var Target: longint;Source : longint) : longint;
+  var
+    temp_sreg : byte;
+  begin
+    { block interrupts }
+    asm
+    end;
+
+    Result:=Target;
+    Target:=Source;
+
+    { release interrupts }
+    asm
+    end;
+  end;
+
+
+function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comperand: longint): longint;
+  var
+    temp_sreg : byte;
+  begin
+    { block interrupts }
+    asm
+    end;
+
+    Result:=Target;
+    if Target=Comperand then
+      Target:=NewValue;
+
+    { release interrupts }
+    asm
+    end;
+  end;
+
+
+function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint;
+  var
+    temp_sreg : byte;
+  begin
+    { block interrupts }
+    asm
+    end;
+
+    Result:=Target;
+    inc(Target,Source);
+
+    { release interrupts }
+    asm
+    end;
+  end;
+
+
+function InterLockedDecrement (var Target: smallint) : smallint;
+  var
+    temp_sreg : byte;
+  begin
+    { block interrupts }
+    asm
+    end;
+
+    dec(Target);
+    Result:=Target;
+
+    { release interrupts }
+    asm
+    end;
+  end;
+
+
+function InterLockedIncrement (var Target: smallint) : smallint;
+  var
+    temp_sreg : byte;
+  begin
+    { block interrupts }
+    asm
+    end;
+
+    inc(Target);
+    Result:=Target;
+
+    { release interrupts }
+    asm
+    end;
+  end;
+
+
+function InterLockedExchange (var Target: smallint;Source : smallint) : smallint;
+  var
+    temp_sreg : byte;
+  begin
+    { block interrupts }
+    asm
+    end;
+
+    Result:=Target;
+    Target:=Source;
+
+    { release interrupts }
+    asm
+    end;
+  end;
+
+
+function InterlockedCompareExchange(var Target: smallint; NewValue: smallint; Comperand: smallint): smallint;
+  var
+    temp_sreg : byte;
+  begin
+    { block interrupts }
+    asm
+    end;
+
+    Result:=Target;
+    if Target=Comperand then
+      Target:=NewValue;
+
+    { release interrupts }
+    asm
+    end;
+  end;
+
+
+function InterLockedExchangeAdd (var Target: smallint;Source : smallint) : smallint;
+  var
+    temp_sreg : byte;
+  begin
+    { block interrupts }
+    asm
+    end;
+
+    Result:=Target;
+    inc(Target,Source);
+
+    { release interrupts }
+    asm
+    end;
+  end;