Return to primtest.fs CVS log

Up to [gforth] / gforth / test

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: