Return to prims2cl.fs CVS log

Up to [gforth] / gforth

Annotation of gforth/prims2cl.fs, revision 1.1

1.1     ! jwilke      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: