Annotation of gforth/test/primtest.fs, revision 1.1
1.1 ! anton 1: \ test for Gforth primitives
! 2:
! 3: \ Copyright (C) 2003 Free Software Foundation, Inc.
! 4:
! 5: \ This file is part of Gforth.
! 6:
! 7: \ Gforth is free software; you can redistribute it and/or
! 8: \ modify it under the terms of the GNU General Public License
! 9: \ as published by the Free Software Foundation; either version 2
! 10: \ of the License, or (at your option) any later version.
! 11:
! 12: \ This program is distributed in the hope that it will be useful,
! 13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
! 14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! 15: \ GNU General Public License for more details.
! 16:
! 17: \ You should have received a copy of the GNU General Public License
! 18: \ along with this program; if not, write to the Free Software
! 19: \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
! 20:
! 21: Create mach-file here over 1+ allot place
! 22:
! 23: 0 [IF]
! 24: \ debugging: produce a relocation and a symbol table
! 25: s" rel-table" r/w create-file throw
! 26: Constant fd-relocation-table
! 27:
! 28: \ debuggging: produce a symbol table
! 29: s" sym-table" r/w create-file throw
! 30: Constant fd-symbol-table
! 31: [THEN]
! 32:
! 33:
! 34: bl word vocabulary find nip 0= [IF]
! 35: \ if search order stuff is missing assume we are compiling on a gforth
! 36: \ system and include it.
! 37: \ We want the files taken from our current gforth installation
! 38: \ so we don't include relatively to this file
! 39: require startup.fs
! 40: [THEN]
! 41:
! 42: \ include etags.fs
! 43:
! 44: include ./../cross.fs \ cross-compiler
! 45:
! 46: decimal
! 47:
! 48: has? kernel-start has? kernel-size makekernel
! 49: \ create image-header
! 50: has? header [IF]
! 51: here 1802 over
! 52: A, \ base address
! 53: 0 , \ checksum
! 54: 0 , \ image size (without tags)
! 55: has? kernel-size
! 56: , \ dict size
! 57: has? stack-size , \ data stack size
! 58: has? fstack-size , \ FP stack size
! 59: has? rstack-size , \ return stack size
! 60: has? lstack-size , \ locals stack size
! 61: 0 A, \ code entry point
! 62: 0 A, \ throw entry point
! 63: has? stack-size , \ unused (possibly tib stack size)
! 64: 0 , \ unused
! 65: 0 , \ data stack base
! 66: 0 , \ fp stack base
! 67: 0 , \ return stack base
! 68: 0 , \ locals stack base
! 69: [THEN]
! 70:
! 71: doc-off
! 72: has? prims [IF]
! 73: include ./../kernel/aliases.fs \ primitive aliases
! 74: [ELSE]
! 75: prims-include
! 76: undef-words
! 77: include prim.fs
! 78: all-words
! 79: [THEN]
! 80: doc-on
! 81:
! 82: has? header [IF]
! 83: 1802 <> [IF] .s cr .( header start address expected!) cr uffz [THEN]
! 84: AConstant image-header
! 85: : forthstart image-header @ ;
! 86: [THEN]
! 87:
! 88: \ 0 AConstant forthstart
! 89:
! 90: : emit ( c -- )
! 91: stdout emit-file drop ;
! 92:
! 93: : cr ( -- )
! 94: 10 emit ;
! 95:
! 96: : type ( addr u -- )
! 97: stdout write-file drop ;
! 98:
! 99: : boot ( -- )
! 100: [char] a stdout emit-file drop
! 101: [char] b emit
! 102: s" cde" type
! 103: ." fgh"
! 104: cr
! 105: 0 (bye) ;
! 106:
! 107: \ Setup 13feb93py
! 108:
! 109: has? header [IF]
! 110: \ set image size
! 111: here image-header 2 cells + !
! 112: \ set image entry point
! 113: ' boot >body image-header 8 cells + A!
! 114: [ELSE]
! 115: >boot
! 116: [THEN]
! 117:
! 118: \ include ./../kernel/pass.fs \ pass pointers from cross to target
! 119:
! 120: .unresolved \ how did we do?
! 121:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>