File:  [gforth] / gforth / kernel / main.fs
Revision 1.21: download - view: text, annotated - select for diffs
Sat Sep 23 15:47:10 2000 UTC (20 years, 10 months ago) by anton
Branches: MAIN
CVS tags: v0-5-0, HEAD
changed FSF address in copyright messages

    1: \ MAIN.FS      Kernal main load file                   20may93jaw
    2: 
    3: \ Copyright (C) 1995,1996,1997,1998,2000 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: \ : include bl word count included ;
   22: \ we want write include...
   23: 
   24: \ : : ( -- colon-sys )  Header [ ' : @ ] ALiteral cfa, 0 ] ;
   25: \ : ; ( colon-sys -- )  ?struc postpone exit reveal postpone [ ; immediate
   26: \ : :noname ( -- xt colon-sys )  here [ ' : @ ] ALiteral cfa, 0 ] ;
   27: 
   28: Create mach-file here over 1+ allot place
   29: 
   30: 0 [IF]
   31: \ debugging: produce a relocation and a symbol table
   32: s" rel-table" r/w create-file throw
   33: Constant fd-relocation-table
   34: 
   35: \ debuggging: produce a symbol table
   36: s" sym-table" r/w create-file throw
   37: Constant fd-symbol-table
   38: [THEN]
   39: 
   40: 
   41: bl word vocabulary find nip 0= [IF]
   42: \ if search order stuff is missing assume we compile on a gforth
   43: \ system and include it
   44: \ We want the files taken from out current gforth installation
   45: \ so we don't include relatively to this file
   46: 
   47: require search.fs
   48: require environ.fs
   49: require envos.fs
   50: require errors.fs
   51: require extend.fs              \ load core-extended
   52: require hash.fs
   53: 
   54: [THEN]
   55: 
   56: \ include etags.fs
   57: 
   58: include ./../cross.fs               \ include cross-compiler
   59: 
   60: decimal
   61: 
   62: has? kernel-size makekernel ( size )
   63: \ create image-header
   64: has? header [IF]
   65: 0 A,	\ base address
   66: 0 ,	\ checksum
   67: 0 ,	\ image size (without tags)
   68: >address ,	\ dict size
   69: has? stack-size ,	\ data stack size
   70: has? fstack-size ,	\ FP stack size
   71: has? rstack-size ,	\ return stack size
   72: has? lstack-size ,	\ locals stack size
   73: 0 A,	\ code entry point
   74: 0 A,	\ throw entry point
   75: has? stack-size ,	\ unused (possibly tib stack size)
   76: 0 ,	\ unused
   77: 0 ,	\ data stack base
   78: 0 ,	\ fp stack base
   79: 0 ,	\ return stack base
   80: 0 ,	\ locals stack base
   81: [THEN]
   82: 
   83: UNLOCK ghost - drop \ ghost must exist because - would be treated as number
   84: LOCK
   85: 
   86: doc-off
   87: has? prims [IF]
   88:     include ./aliases.fs             \ include primitive aliases
   89: [ELSE]
   90:     prims-include
   91:     undef-words
   92:     include prim.fs
   93:     all-words  UNLOCK LOCK
   94: [THEN]
   95: doc-on
   96: 
   97: 0 AConstant forthstart
   98: 
   99: \ include ./vars.fs                \ variables and other stuff
  100: \ include kernel/version.fs \ is in $(build)/kernel
  101: include ./kernel.fs              \ load kernel
  102: \ include ./special.fs             \ special must be last!
  103: \ include ./errore.fs
  104: include ./doers.fs
  105: has? file [IF]
  106: include ./args.fs
  107: include ./files.fs               \ load file words
  108: include ./paths.fs
  109: include ./require.fs
  110: [THEN]
  111: 
  112: has? compiler [IF]
  113: has? glocals [IF]
  114: include ./cond.fs                \ load IF and co
  115: [ELSE]
  116: include ./cond-old.fs            \ load IF and co w/o locals
  117: [THEN]
  118: \ include arch/misc/tt.fs
  119: \ include arch/misc/sokoban.fs
  120: [THEN]
  121: include ./quotes.fs
  122: include ./toolsext.fs
  123: include ./tools.fs               \ load tools ( .s dump )
  124: include ./getdoers.fs
  125: 
  126: \ Setup                                                13feb93py
  127: 
  128: has? header [IF]
  129: \    UNLOCK
  130:     here >address 2 cells  !  \ image size
  131:     ' boot >body  8 cells A!  \ Entry point
  132: \    LOCK
  133: [ELSE]
  134:   >boot
  135: [THEN]
  136: 
  137: include ./pass.fs
  138: 
  139: .unresolved

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>