File:  [gforth] / gforth / prims2cl.fs
Revision 1.11: download - view: text, annotated - select for diffs
Mon Dec 31 15:25:18 2012 UTC (11 years, 2 months ago) by anton
Branches: MAIN
CVS tags: HEAD
updated copyright year

    1: \ prims2cl.fs	Primitives to c-library code
    2: 
    3: \ Copyright (C) 1998,1999,2001,2003,2007,2012 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 3
   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, see http://www.gnu.org/licenses/.
   19: 
   20: \ Author: Jens Wilke
   21: \ Revision Log
   22: \ 09oct97jaw V1.0	Initial Version
   23: 
   24: include ./prims2x.fs
   25: 
   26: Create 	InputFile 130 chars allot
   27: 
   28: : c-code
   29:     InputFile count ['] output-c-func ['] abort process-file
   30:     ;
   31: 
   32: : c-names
   33:     InputFile count ['] output-funclabel ['] abort process-file
   34:     ;
   35: 
   36: : forth-names
   37:     InputFile count ['] output-forthname dup process-file
   38:     ;
   39: 
   40: : .\ 
   41:     0 word count pad place pad count postpone sliteral postpone type postpone cr ; immediate
   42:  
   43: : c-header
   44: 	.\ #include "engine/forth.h"
   45: 	.\ 
   46: 	.\ #undef TOS
   47: 	.\ #define TOS sp[0]
   48: 	.\ #undef IF_TOS
   49: 	.\ #define IF_TOS(x)
   50: 	.\ #undef NEXT_P2
   51: 	.\ #define NEXT_P2 
   52: 	.\ #undef NEXT_P1
   53: 	.\ #define NEXT_P1
   54: 	.\ #undef NEXT_P0
   55: 	.\ #define NEXT_P0
   56: 	.\ #undef NAME
   57: 	.\ #define NAME(x)
   58: 	.\ #undef DEF_CA
   59: 	.\ #define DEF_CA
   60: 	.\ #undef I_
   61: 	.\ #define I_ I_
   62: 	.\
   63: 	.\ #define NAME_LEN 32
   64: 	.\ #define NULL 0
   65: 	.\
   66:    ;
   67: 
   68: : catalog
   69: 	.\ void *catalog(int p)
   70: 	.\ {
   71: 	.\         static void  *ADDR_TABLE[]={
   72:     c-names
   73: 	.\ };
   74: 	.\         static char NAME_TABLE[][NAME_LEN]={
   75:     forth-names
   76: 	.\ };
   77: 	."         int funcs=" function-number @ s>d <# #S #> type ." ;" cr
   78: 	.\
   79: 	.\        static struct { void *func;
   80: 	.\              	  char len;
   81: 	.\                        char name[NAME_LEN];
   82: 	.\                        }f;
   83: 	.\
   84: 	.\        switch (p)
   85: 	.\        {       case -2:   	/*
   86: 	.\                             	 We return the table known words
   87: 	.\                               don't use this!!!
   88: 	.\                               */
   89: 	.\                              return (NAME_TABLE[0]);
   90: 	.\
   91: 	.\                case -1:	/*
   92: 	.\                          	 Return number of words in this module
   93: 	.\                               */
   94: 	.\                           	return ((void *) funcs);
   95: 	.\         }
   96: 	.\	        /*
   97: 	.\                Check for valid function number
   98: 	.\          */
   99: 	.\         if (p<0 || p>=funcs) return (0);
  100: 	.\         /*
  101: 	.\                Find matching forth word and return its address
  102: 	.\         */
  103: 	.\         strcpy(f.name,NAME_TABLE[p]);
  104: 	.\         f.len=strlen(f.name);
  105: 	.\         f.func=ADDR_TABLE[p];
  106: 	.\         return (&f);
  107: 	.\ }
  108:     ;
  109: 
  110: : main
  111:   c-header
  112:   c-code
  113:   catalog
  114:   ;
  115: 
  116: : file
  117:   bl word count InputFile place ;
  118: 

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