[OpenBIOS] r469 - cpu cpu/i8051 forth/kernel

svn at openbios.org svn at openbios.org
Mon Jul 16 09:10:06 CEST 2007


Author: wmb
Date: 2007-07-16 09:10:05 +0200 (Mon, 16 Jul 2007)
New Revision: 469

Added:
   cpu/i8051/
   cpu/i8051/kernel.bth
   cpu/i8051/metainit.fth
   cpu/i8051/target.fth
   forth/kernel/conf16.fth
Log:
Added basic structure for 8051 Forth kernel.


Added: cpu/i8051/kernel.bth
===================================================================
--- cpu/i8051/kernel.bth	                        (rev 0)
+++ cpu/i8051/kernel.bth	2007-07-16 07:10:05 UTC (rev 469)
@@ -0,0 +1,103 @@
+purpose: Load file for x86 Forth kernel
+\ See license at end of file
+
+command: &builder &this
+build-now
+
+: \Tags  [compile] \ ; immediate
+: \NotTags  ;  immediate
+
+\ ' $report-name is include-hook	' noop is include-exit-hook
+  ' noop is include-hook		' noop is include-exit-hook
+
+warning off	\ Turn OFF the warning messages
+
+: resident ;
+
+fload ${BP}/forth/kernel/conf16.fth
+fload ${BP}/forth/kernel/meta1.fth
+
+only forth also meta also definitions
+\needs 8015-assembler caps @ caps on  fload ${BP}/cpu/i8051/assem.fth caps !
+
+only forth also meta assembler also meta definitions
+: assembler  ( -- )  8051-assembler  ;
+
+only forth also meta also assembler definitions
+fload ${BP}/forth/lib/loclabel.fth         \ Local label assembler feature
+
+\ : : : lastacf .name cr ;   \ Debugging tool
+
+fload ${BP}/cpu/i8051/target.fth           \ Target configuration
+
+fload ${BP}/forth/kernel/forward.fth       \ Metacompiler forward referencing
+fload ${BP}/forth/kernel/metacompile.fth   \ Metacompiler
+
+fload ${BP}/cpu/i8051/metainit.fth         \ Turn on the metacompiler
+
+always-headers  \ Don't omit any headers
+
+\ Comment out the following lines when debugging
+-1  threshold  !	\ Turn OFF ALL debugging messages
+warning-t  off  	\ Turn OFF target warning messages
+
+\ Uncomment the following line(s) for more debug output
+\ show? on  1 granularity !  1 threshold !
+\ warning-t on
+
+fload ${BP}/cpu/i8051/kerncode.fth         \ CPU-dependent Forth kernel
+
+[ifdef] notdef    \ This is the FirmWorks Forth kernel high-level code
+: \tagvoc ; immediate
+: \nottagvoc [compile] \ ; immediate
+
+\ fload ${BP}/forth/kernel/uservars.fth
+\ fload ${BP}/forth/kernel/double.fth
+\ \ : (d.)  (  d -- adr len )  tuck dabs <# #s rot sign #>  ;
+\ \ fload ${BP}/forth/kernel/dmuldiv.fth
+
+\ fload ${BP}/forth/lib/bitops.fth
+\ fload ${BP}/forth/lib/struct.fth
+\ fload ${BP}/forth/kernel/kernel.fth
+\ fload ${BP}/forth/kernel/sysio.fth
+\ fload ${BP}/forth/lib/dumballo.fth
+\ fload ${BP}/cpu/x86/syscall.fth
+\ fload ${BP}/cpu/x86/boot.fth
+\ fload ${BP}/forth/kernel/init.fth
+\ fload ${BP}/cpu/x86/finish.fth
+[then]
+
+' (do-literal) is do-literal
+
+\ Save the result to a file
+writing kernel.img
+origin-t >hostaddr  here-t origin-t -  ofd @  fputs
+ofd @ fclose
+
+warning on
+
+hex
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2007 FirmWorks
+\ 
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\ 
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\ 
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END

Added: cpu/i8051/metainit.fth
===================================================================
--- cpu/i8051/metainit.fth	                        (rev 0)
+++ cpu/i8051/metainit.fth	2007-07-16 07:10:05 UTC (rev 469)
@@ -0,0 +1,62 @@
+\ See license at end of file
+\ Metacompiler initialization
+
+\ Debugging aids
+
+
+\ Threshold is the word number to start reporting progress
+\ granularity is how often (how many words) to report progress
+0 #words !  h# 0 threshold !  h# 10 granularity !
+
+warning off
+forth definitions
+
+metaon
+meta definitions
+
+\ We want the kernel to be romable, so we put variables in the user area
+:-h variable  ( -- )  nuser  ;-h
+alias \m  \
+
+initmeta
+
+h# 10000 alloc-mem  target-image  \ Allocate space for the target image
+
+\ org sets the lowest address that is used by Forth kernel.
+\ This number is a target token rather than an absolute address.
+hex
+
+0.0000 org  0.0000 voc-link-t token-t!
+
+ps-size-t equ ps-size
+
+assembler
+
+\ This is at the first location in the Forth image.
+
+hex
+mlabel cld
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2007 FirmWorks
+\ 
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\ 
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\ 
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END

Added: cpu/i8051/target.fth
===================================================================
--- cpu/i8051/target.fth	                        (rev 0)
+++ cpu/i8051/target.fth	2007-07-16 07:10:05 UTC (rev 469)
@@ -0,0 +1,216 @@
+\ See license at end of file
+\ Target configuration - i8051
+
+only forth also definitions
+
+decimal
+
+only forth also meta definitions
+
+: lobyte h# 0ff and ;
+: hibyte 8 rshift lobyte ;
+
+2 constant /w-t
+/l-t constant /n-t
+/w-t constant /a-t
+/a-t constant /thread-t
+/w-t constant /token-t
+/w-t constant /link-t
+/token-t constant /defer-t
+\ /n-t h# 600 * constant user-size-t
+\ /n-t h# 100 * constant ps-size-t
+\ /n-t h# 100 * constant rs-size-t
+/w-t constant /user#-t
+
+\ user-size-t h# 10000 + constant max-kernel-t
+
+\ 32 bit host Forth compiling 16-bit target Forth
+
+: n->n-t ; immediate
+
+: c!-t ( n add -- ) >hostaddr c! ;
+: c at -t ( target-address -- n ) >hostaddr c@ ;
+
+\ Intel processors are little-endian
+: w!-t ( n add -- )  over lobyte over c!-t  ca1+ swap hibyte swap c!-t  ;
+: w at -t ( target-address -- n )  dup c at -t swap 1+ c at -t 8 << or  ;
+
+alias le-w!-t w!-t
+alias le-w at -t w at -t
+
+: !-t  ( n add -- ) w!-t ;
+: @-t  ( target-address -- n ) w at -t ;
+
+\ Store target data types into the host address space.
+: c-t!  ( c host-address -- )  c!  ;
+: w-t!  ( w host-address -- )
+   over lobyte  over c-t!  ca1+  swap hibyte swap c-t!
+;
+: n-t!  ( n host-address -- )  w-t!  ;
+
+\ Next 2 are machine-independent
+: c,-t ( byte -- )  dp-t @ c!-t 1 dp-t +! ;
+: w,-t ( word -- )  dp-t @ w!-t /w-t dp-t +! ;
+
+: ,-t ( n -- )  w,-t ;
+: ,user#-t ( user# -- )  w,-t  ;
+
+: a at -t ( target-address -- target-address )  w at -t  origin-t +  ;
+: a!-t ( token target-address -- )  swap  origin-t -  swap  w!-t  ;
+: token at -t ( target-address -- target-acf )  a at -t  ;
+: token!-t ( acf target-address -- )  a!-t  ;
+
+: rlink at -t  ( occurrence -- next-occurrence )  w at -t  origin-t +  ;
+: rlink!-t  ( next-occurrence occurrence -- ) swap  origin-t -  swap  w!-t  ;
+
+\ Machine independent
+: a,-t  ( adr -- )  here-t /a-t allot-t  a!-t  ;
+: token,-t ( token -- )  here-t /token-t allot-t  token!-t  ;
+
+\ These versions of linkx-t are for absolute links
+: link at -t ( target-address -- target-address' )  a at -t  ;
+: link!-t ( target-address target-address -- )  a!-t  ;
+: link,-t ( target-address -- )  a,-t  ;
+
+: a-t@ ( host-address -- target-address )  w@  origin-t +  ;
+: a-t! ( target-address host-address -- ) swap origin-t -  swap w!  ;
+: rlink-t@  ( host-adr -- target-adr )  w@  origin-t +  ;
+: rlink-t!  ( target-adr host-adr -- )  swap origin-t -  swap w!  ;
+
+: token-t@ ( host-address -- target-acf )  a-t@  ;
+: token-t! ( target-acf host-address -- )  a-t!  ;
+
+: link-t@  ( host-address -- target-address )  a-t@  ;
+: link-t!  ( target-address host-address -- )  a-t!  ;
+
+\ Machine independent
+: a-t, ( target-address -- )  here  /a-t allot  a-t!  ;
+: token-t, ( target-address -- )  here  /token-t allot  token-t!  ;
+
+\ Dictionary linked list; the list head is in the metacompiler environment
+\ during metacompilation
+1 constant #threads-t
+create threads-t   #threads-t /link-t * allot
+
+\ Choose the dictionary list head based on the word name
+: $hash-t  ( str-addr voc-ptr -- thread )
+   nip swap c@  #threads-t 1- and  /thread-t * +
+;
+
+\ The user area image lives in the host address space.
+\ We wish to store into the user area with -t commands so as not
+\ to need separate words to store target items into host addresses.
+\ That is why user+ returns a target address.
+
+\ Machine Independent
+
+0 constant userarea-t
+: setup-user-area ( -- )
+   here-t  ['] userarea-t >body  l!
+   here-t  ['] init-user-area >body !
+   user-size-t allot-t
+   userarea-t >hostaddr user-size-t  erase
+;
+
+: (>user-t)    ( cfa-t -- user-address-t )  >body-t  w at -t  userarea-t  +  ;
+: >user-t  ( cfa-t -- user-address-h )  (>user-t)  >hostaddr  ;
+
+: n>link-t ( anf-t -- alf-t )  /link-t - ;
+: l>name-t ( alf-t -- anf-t )  /link-t + ;
+
+decimal
+1 constant #align-t
+1 constant #talign-t
+#align-t constant #acf-align-t
+
+1 constant #linkalign-t
+: aligned-t  ( n1 -- n2 )  #align-t 1- +  #align-t negate and  ;
+: acf-aligned-t  ( n1 -- n2 )  #acf-align-t 1- +  #acf-align-t negate and  ;
+
+: align-t ( -- )
+   begin   here-t #align-t  1- and   while   0 c,-t   repeat
+;
+: talign-t ( -- )
+   begin   here-t #talign-t 1- and   while   0 c,-t   repeat
+;
+: linkalign-t  ( -- )
+   begin   here-t #linkalign-t 1- and   while   0 c,-t   repeat
+;
+: acf-align-t  ( -- )   align-t  ;
+
+: entercode ( -- )
+   only forth also labels also meta also 8051-assembler
+;
+
+\ Next 4 are Machine Independent
+: cmove-t ( from to-t n -- )
+   0 ?do over c@  over c!-t  1+ swap 1+ swap loop  2drop
+;
+: place-cstr-t  ( adr len cstr-adr-t -- cstr-adr-t )
+   >r  tuck r@ swap cmove-t  ( len ) r@ +  0 swap c!-t  r>
+;
+: "copy-t ( from to-t -- )  over c@ 2+  cmove-t  ;
+: toggle-t ( addr-t n -- ) swap >r r@ c at -t xor r> c!-t  ;
+
+: clear-threads-t  ( hostaddr -- )
+   #threads-t /link-t * bounds  do
+      origin-t i link-t!
+   /link +loop
+;
+: initmeta  ( -- )
+   init-relocation-t
+   threads-t clear-threads-t  threads-t current-t !
+;
+
+\ For compiling branch offsets used by control constructs.
+\ These compile relative branches.
+
+\ XXX this is wrong.  We need to do some stuff like "lcall zerosense; jz <target>"
+/w-t constant /branch
+: branch! ( from-t target-addr-t -- )  over -  swap  ( offset from-t )   w!-t  ;
+: branch, ( target-t -- )  here-t -  w,-t  ;
+
+\ XXX FIXME for subroutine threaded
+: >body-t ( cfa-t -- pfa-t )  /n-t +  ;   \ This version is for indirect threaded
+
+\ Store actions for some data types.
+
+: isuser  ( n acf -- )  >user-t n-t!  ;
+: istuser ( acf1 acf -- )  (>user-t) >hostaddr token-t!  ;
+: isvalue ( n acf -- )  >user-t n-t!  ;
+: isdefer ( acf acf -- )  (>user-t) >hostaddr token-t!  ;
+: thread-t!  ( thread adr -- )  link-t!  ;
+
+only forth also meta also definitions
+: install-target-assembler  ( -- )
+   [ also assembler ]
+   ['] here-t  is here
+   ['] allot-t is asm-allot
+   ['] c!-t    is asm8!
+   [ previous meta ]
+;
+: install-host-assembler  ( -- )  [ assembler ] resident [ meta ]  ;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2007 FirmWorks
+\ 
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\ 
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\ 
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END

Added: forth/kernel/conf16.fth
===================================================================
--- forth/kernel/conf16.fth	                        (rev 0)
+++ forth/kernel/conf16.fth	2007-07-16 07:10:05 UTC (rev 469)
@@ -0,0 +1,45 @@
+\ See license at end of file
+purpose: Configure metacompiler to build a 16bit subroutine-threaded kernel
+
+only forth also definitions
+
+warning @  warning off
+: 16\ ; immediate
+: 32\ [compile] \ ; immediate
+: 64\ [compile] \ ; immediate
+warning !
+
+: \itc-t ( -- ) [compile] \  ; immediate
+: \dtc-t ( -- ) [compile] \  ; immediate
+: \stc-t ( -- )              ; immediate
+: \ttc-t ( -- ) [compile] \  ; immediate
+: \t8-t  ( -- ) [compile] \  ; immediate
+: \t16-t ( -- )              ; immediate
+: \t32-t ( -- ) [compile] \  ; immediate
+: \t16-t ( -- ) [compile] \  ; immediate
+: \tagvoc-t ( -- )                 ; immediate
+: \nottagvoc-t ( -- ) [compile] \  ; immediate      
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2007 FirmWorks
+\ 
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\ 
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\ 
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END




More information about the OpenBIOS mailing list