File:  [gforth] / gforth / prims2cl.fs
Revision 1.6: download - view: text, annotated - select for diffs
Sun Mar 9 15:16:52 2003 UTC (16 years, 8 months ago) by anton
Branches: MAIN
CVS tags: v0-6-1, v0-6-0, HEAD
updated copyright years

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

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