Return to prims2cl.fs CVS log

Up to [gforth] / gforth

Supports to build up c libraries of forth words in the format used in the
prim file. Worked on linux machines.
On sun linker exits with "fatal signal 6"...

    1: \ prims2cl.fs	Primitives to c-library code
    2: 
    3: \ Copyright (C) 1998 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., 675 Mass Ave, Cambridge, MA 02139, 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 process-file
   31:     ;
   32: 
   33: : c-names
   34:     InputFile count ['] output-funclabel process-file
   35:     ;
   36: 
   37: : forth-names
   38:     InputFile count ['] output-forthname 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 return
   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: 	.\ extern int *FP;
   67: 	.\ extern int *SP;
   68: 	.\ #define sp SP
   69: 	.\ #define fp FP
   70: 	.\
   71: 	.\ #define NAME_LEN 32
   72: 	.\ #define NULL 0
   73: 	.\
   74:    ;
   75: 
   76: : catalog
   77: 	.\ void *catalog(int p)
   78: 	.\ {
   79: 	.\         static void  *ADDR_TABLE[]={
   80:     c-names
   81: 	.\ };
   82: 	.\         static char NAME_TABLE[][NAME_LEN]={
   83:     forth-names
   84: 	.\ };
   85: 	."         int funcs=" function-number @ s>d <# #S #> type ." ;" cr
   86: 	.\
   87: 	.\        static struct { void *func;
   88: 	.\              	  char len;
   89: 	.\                        char name[NAME_LEN];
   90: 	.\                        }f;
   91: 	.\
   92: 	.\        switch (p)
   93: 	.\        {       case -2:   	/*
   94: 	.\                             	 We return the table known words
   95: 	.\                               don't use this!!!
   96: 	.\                               */
   97: 	.\                              return (NAME_TABLE[0]);
   98: 	.\
   99: 	.\                case -1:	/*
  100: 	.\                          	 Return number of words in this module
  101: 	.\                               */
  102: 	.\                           	return ((void *) funcs);
  103: 	.\         }
  104: 	.\	        /*
  105: 	.\                Check for valid function number
  106: 	.\          */
  107: 	.\         if (p<0 || p>=funcs) return (0);
  108: 	.\         /*
  109: 	.\                Find matching forth word and return its address
  110: 	.\         */
  111: 	.\         strcpy(f.name,NAME_TABLE[p]);
  112: 	.\         f.len=strlen(f.name);
  113: 	.\         f.func=ADDR_TABLE[p];
  114: 	.\         return (&f);
  115: 	.\ }
  116:     ;
  117: 
  118: : main
  119:   c-header
  120:   c-code
  121:   catalog
  122:   ;
  123: 
  124: : file
  125:   bl word count InputFile place ;
  126: