aboutsummaryrefslogtreecommitdiff
path: root/scaf/system/kernel.scaf
diff options
context:
space:
mode:
Diffstat (limited to 'scaf/system/kernel.scaf')
-rw-r--r--scaf/system/kernel.scaf130
1 files changed, 130 insertions, 0 deletions
diff --git a/scaf/system/kernel.scaf b/scaf/system/kernel.scaf
new file mode 100644
index 0000000..0bc2788
--- /dev/null
+++ b/scaf/system/kernel.scaf
@@ -0,0 +1,130 @@
+( Pure Data Packet - scaforth kernel. )
+( Copyright (c) by Tom Schouten <pdp@zzz.kotnet.org> )
+( )
+( This program is free software; you can redistribute it and/or modify )
+( it under the terms of the GNU General Public License as published by )
+( the Free Software Foundation; either version 2 of the License, or )
+( [at your option] any later version. )
+( )
+( 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. See the )
+( GNU General Public License for more details. )
+( )
+( You should have received a copy of the GNU General Public License )
+( along with this program; if not, write to the Free Software )
+( Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. )
+
+
+
+
+
+( this file contains the inline words in the scaforth kernel. )
+( when a file is compiled to asm, it will consist of word )
+( definition asm routines, macros and jmp call ret instructions. )
+( )
+( all words in this file are defined in terms of asm macros )
+( defined in scafmacros.s )
+
+
+
+( stack manip words )
+
+: over dup dropover ;
+
+( neighbourhood cell fetch words )
+
+: @-+ dup dropldTL ;
+: @0+ dup dropldTM ;
+: @++ dup dropldTR ;
+: @-0 dup dropldML ;
+: @00 dup dropldMM ;
+: @+0 dup dropldMR ;
+: @-- dup dropldBL ;
+: @0- dup dropldBM ;
+: @+- dup dropldBR ;
+
+( boolean logic )
+
+: or overor nip ;
+: xor overxor nip ;
+: and overand nip ;
+
+( binary constant loading )
+
+: 1 dup dropone ;
+: 0 dup dropzero ;
+
+( 4,3,2,1 bit add stack to register, leave carry on stack )
+
+: ++++ adb0 adb1 adb2 adb3 ;
+: +++ adb0 adb1 adb2 ;
+: ++ adb0 adb1 ;
+: + adb0 ;
+
+( 4,3,2 bit shifted 1 add )
+
+: ++++<<1 adb1 adb2 adb3 ;
+: +++<<1 adb1 adb2 ;
+: ++<<1 adb1 ;
+
+( 4,3 bit shifted 2 add )
+
+: ++++<<2 adb2 adb3 ;
+: +++<<2 adb2 ;
+
+( 4 bit shifted 3 add )
+
+: ++++<<3 adb3 ;
+
+( 4 bit accumulator access )
+
+: !a0 dupsta0 drop ;
+: !a1 dupsta1 drop ;
+: !a2 dupsta2 drop ;
+: !a3 dupsta3 drop ;
+
+: @a0 dup droplda0 ;
+: @a1 dup droplda1 ;
+: @a2 dup droplda2 ;
+: @a3 dup droplda3 ;
+
+( 4,3,2,1 bit accumulator zero tests )
+
+: ?anz dup dropisnonzero4 ;
+: ?anz4 dup dropisnonzero4 ;
+: ?anz3 dup dropisnonzero3 ;
+: ?anz2 dup dropisnonzero2 ;
+: ?anz1 dup dropisnonzero1 ;
+
+( load constants into accumulator )
+
+: a0 a0000 ;
+: a-0 a0000 ;
+: a+0 a0000 ;
+: a+1 a0001 ;
+: a+2 a0010 ;
+: a+3 a0011 ;
+: a+4 a0100 ;
+: a+5 a0101 ;
+: a+6 a0110 ;
+: a+7 a0111 ;
+
+: a+8 a1000 ;
+: a+9 a1001 ;
+: a+10 a1010 ;
+: a+11 a1011 ;
+: a+12 a1100 ;
+: a+13 a1101 ;
+: a+14 a1110 ;
+: a+15 a1111 ;
+
+: a-8 a1000 ;
+: a-7 a1001 ;
+: a-6 a1010 ;
+: a-5 a1011 ;
+: a-4 a1100 ;
+: a-3 a1101 ;
+: a-2 a1110 ;
+: a-1 a1111 ;
+