Annotation of gforth/prims2cl.fs, revision 1.8

1.1       jwilke      1: \ prims2cl.fs  Primitives to c-library code
                      2: 
1.7       anton       3: \ Copyright (C) 1998,1999,2001,2003 Free Software Foundation, Inc.
1.1       jwilke      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
1.8     ! anton       9: \ as published by the Free Software Foundation, either version 3
1.1       jwilke     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
1.8     ! anton      18: \ along with this program. If not, see http://www.gnu.org/licenses/.
1.1       jwilke     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
1.5       anton      29:     InputFile count ['] output-c-func ['] abort process-file
1.1       jwilke     30:     ;
                     31: 
                     32: : c-names
1.5       anton      33:     InputFile count ['] output-funclabel ['] abort process-file
1.1       jwilke     34:     ;
                     35: 
                     36: : forth-names
1.5       anton      37:     InputFile count ['] output-forthname dup process-file
1.1       jwilke     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:        .\ extern char *cstr(Char *from, UCell size, int clear);
                     46:        .\ extern char *tilde_cstr(Char *from, UCell size, int clear);
                     47:        .\ 
                     48:        .\ #undef TOS
                     49:        .\ #define TOS sp[0]
                     50:        .\ #undef IF_TOS
                     51:        .\ #define IF_TOS(x)
                     52:        .\ #undef NEXT_P2
1.2       jwilke     53:        .\ #define NEXT_P2 
1.1       jwilke     54:        .\ #undef NEXT_P1
                     55:        .\ #define NEXT_P1
                     56:        .\ #undef NEXT_P0
                     57:        .\ #define NEXT_P0
                     58:        .\ #undef NAME
                     59:        .\ #define NAME(x)
                     60:        .\ #undef DEF_CA
                     61:        .\ #define DEF_CA
                     62:        .\ #undef I_
                     63:        .\ #define I_ I_
                     64:        .\
                     65:        .\ #define NAME_LEN 32
                     66:        .\ #define NULL 0
                     67:        .\
                     68:    ;
                     69: 
                     70: : catalog
                     71:        .\ void *catalog(int p)
                     72:        .\ {
                     73:        .\         static void  *ADDR_TABLE[]={
                     74:     c-names
                     75:        .\ };
                     76:        .\         static char NAME_TABLE[][NAME_LEN]={
                     77:     forth-names
                     78:        .\ };
                     79:        ."         int funcs=" function-number @ s>d <# #S #> type ." ;" cr
                     80:        .\
                     81:        .\        static struct { void *func;
                     82:        .\                        char len;
                     83:        .\                        char name[NAME_LEN];
                     84:        .\                        }f;
                     85:        .\
                     86:        .\        switch (p)
                     87:        .\        {       case -2:      /*
                     88:        .\                               We return the table known words
                     89:        .\                               don't use this!!!
                     90:        .\                               */
                     91:        .\                              return (NAME_TABLE[0]);
                     92:        .\
                     93:        .\                case -1:      /*
                     94:        .\                               Return number of words in this module
                     95:        .\                               */
                     96:        .\                              return ((void *) funcs);
                     97:        .\         }
                     98:        .\              /*
                     99:        .\                Check for valid function number
                    100:        .\          */
                    101:        .\         if (p<0 || p>=funcs) return (0);
                    102:        .\         /*
                    103:        .\                Find matching forth word and return its address
                    104:        .\         */
                    105:        .\         strcpy(f.name,NAME_TABLE[p]);
                    106:        .\         f.len=strlen(f.name);
                    107:        .\         f.func=ADDR_TABLE[p];
                    108:        .\         return (&f);
                    109:        .\ }
                    110:     ;
                    111: 
                    112: : main
                    113:   c-header
                    114:   c-code
                    115:   catalog
                    116:   ;
                    117: 
                    118: : file
                    119:   bl word count InputFile place ;
                    120: 

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