libcc.h 6.88 KB
Newer Older
anton's avatar
anton committed
1 2
/* header file for libcc-generated C code

3
  Authors: Anton Ertl, Bernd Paysan
Anton Ertl's avatar
Anton Ertl committed
4
  Copyright (C) 2006,2007,2008,2012,2013,2014,2015,2016,2017,2019 Free Software Foundation, Inc.
anton's avatar
anton committed
5 6 7 8 9

  This file is part of Gforth.

  Gforth is free software; you can redistribute it and/or
  modify it under the terms of the GNU General Public License
anton's avatar
anton committed
10
  as published by the Free Software Foundation, either version 3
anton's avatar
anton committed
11 12 13 14 15 16 17 18
  of the License, or (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
anton's avatar
anton committed
19
  along with this program. If not, see http://www.gnu.org/licenses/.
anton's avatar
anton committed
20 21
*/

22
#include "config.h"
23
#include <stddef.h>
Bernd Paysan's avatar
Bernd Paysan committed
24
#include <signal.h>
25
#include <alloca.h>
26
#include <setjmp.h>
27 28
#include <string.h>
#include <stdlib.h>
29

30
#if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) || defined(__ANDROID__)
31 32
#undef HAS_BACKLINK
#endif
33

anton's avatar
anton committed
34
typedef CELL_TYPE Cell;
35
typedef unsigned CELL_TYPE UCell;
pazsan's avatar
pazsan committed
36
typedef unsigned char Char;
anton's avatar
anton committed
37
typedef double Float;
pazsan's avatar
pazsan committed
38 39
typedef Char *Address;
typedef void **Xt;
anton's avatar
anton committed
40 41 42 43

#define Clongest long long
typedef unsigned Clongest UClongest;

pazsan's avatar
pazsan committed
44 45 46 47 48 49 50 51 52 53 54
typedef struct {
  Cell next_task;
  Cell prev_task;
  Cell save_task;
  Cell* sp0;
  Cell* rp0;
  Float* fp0;
  Address lp0;
  Xt *throw_entry;
} user_area;

55
typedef struct {
Bernd Paysan's avatar
Bernd Paysan committed
56 57
  Cell* spx;
  Float* fpx;
Anton Ertl's avatar
Anton Ertl committed
58
} gforth_stackpointers;
59

Bernd Paysan's avatar
Bernd Paysan committed
60 61
#define ARGN(s, f) int MAYBE_UNUSED arg0=s, farg0=f

62 63
typedef struct {
  Cell magic;
64 65 66 67
  Cell *handler;
  Cell first_throw;
  Cell *wraphandler; /* experimental */
  jmp_buf * throw_jumpptr;
68 69 70 71 72
  Cell *spx;
  Cell *rpx;
  Address lpx;
  Float *fpx;
  user_area* upx;
73 74 75 76
  Cell *s_ip;
  Cell *s_rp;
} stackpointers;

Bernd Paysan's avatar
Bernd Paysan committed
77
#ifdef HAS_BACKLINK
78
#define gforth_magic (gforth_SPs.magic)
79 80 81 82 83
#define gforth_SP (gforth_SPs.spx)
#define gforth_RP (gforth_SPs.rpx)
#define gforth_LP (gforth_SPs.lpx)
#define gforth_FP (gforth_SPs.fpx)
#define gforth_UP (gforth_SPs.upx)
84 85
#define saved_ip (gforth_SPs.s_ip)
#define saved_rp (gforth_SPs.s_rp)
86
#define throw_jmp_handler (gforth_SPs.throw_jumpptr)
87 88

extern PER_THREAD stackpointers gforth_SPs;
Bernd Paysan's avatar
Bernd Paysan committed
89 90 91
#define get_gforth_SPs() (&gforth_SPs)
#define sr_call , get_gforth_SPs()
extern void *gforth_engine(Xt *, stackpointers *);
pazsan's avatar
pazsan committed
92 93
extern char *cstr(char *from, Cell size);
extern char *tilde_cstr(char *from, Cell size);
94 95
extern user_area* gforth_stacks(Cell dsize, Cell rsize, Cell fsize, Cell lsize);
extern void gforth_free_stacks(user_area* t);
96
extern user_area *gforth_main_UP;
97
extern Cell gforth_go(Xt *ip);
Bernd Paysan's avatar
Bernd Paysan committed
98
extern void gforth_sigset(sigset_t* set, ...);
99
extern void gforth_setstacks(user_area*);
Anton Ertl's avatar
Anton Ertl committed
100 101
#define GFORTH_ARGS gforth_stackpointers x, void* cdesc
gforth_stackpointers gforth_libcc_init(GFORTH_ARGS)
102
{
Anton Ertl's avatar
Anton Ertl committed
103
  x.spx++;
104
  return x;
105
}
106
#else
Bernd Paysan's avatar
Bernd Paysan committed
107 108 109 110 111 112 113 114 115 116 117 118 119 120 121
#define gforth_SPs ((stackpointers *)(gforth_pointers(0)))
#define get_gforth_SPs() ((stackpointers *)(gforth_pointers(0)))
#define sr_call , get_gforth_SPs()

#define gforth_magic (gforth_SPs->magic)
#define gforth_SP (gforth_SPs->spx)
#define gforth_RP (gforth_SPs->rpx)
#define gforth_LP (gforth_SPs->lpx)
#define gforth_FP (gforth_SPs->fpx)
#define gforth_UP (gforth_SPs->upx)
#define saved_ip (gforth_SPs->s_ip)
#define saved_rp (gforth_SPs->s_rp)
#define throw_jmp_handler (gforth_SPs->throw_jumpptr)

#define gforth_engine ((char *(*)(Xt*, stackpointers *))gforth_pointers(1))
122 123
#define cstr ((char *(*)(char *, Cell))gforth_pointers(2))
#define tilde_cstr ((char *(*)(char *, Cell))gforth_pointers(3))
124 125 126 127 128
#define gforth_stacks ((user_area *(*)(Cell, Cell, Cell, Cell))gforth_pointers(4))
#define gforth_free_stacks ((void(*)(user_area*))gforth_pointers(5))
#define gforth_main_UP *((user_area **)(gforth_pointers(6)))
#define gforth_go ((Cell(*)(Xt*))gforth_pointers(7))
#define gforth_sigset ((void(*)(sigset_t*, ...))gforth_pointers(8))
129
#define gforth_setstacks ((void(*)(user_area*))gforth_pointers(9))
Anton Ertl's avatar
Anton Ertl committed
130
#define GFORTH_ARGS gforth_stackpointers x, void* a_addr
Bernd Paysan's avatar
Bernd Paysan committed
131 132

static Cell *(*gforth_pointers)(Cell);
Anton Ertl's avatar
Anton Ertl committed
133
gforth_stackpointers gforth_libcc_init(GFORTH_ARGS)
Bernd Paysan's avatar
Bernd Paysan committed
134
{
Anton Ertl's avatar
Anton Ertl committed
135
  gforth_pointers=(Cell *(*)(Cell))*x.spx++;
Bernd Paysan's avatar
Bernd Paysan committed
136 137
  return x;
}
138
#endif
anton's avatar
anton committed
139

140 141 142 143 144 145
#if SIZEOF_CHAR_P == 4
#define GFORTH_MAGIC 0x3B3C51D5U
#else
#define GFORTH_MAGIC 0x1E059AF1785E72D4ULL
#endif

anton's avatar
anton committed
146 147 148
#define CELL_BITS	(sizeof(Cell) * 8)

#define gforth_d2ll(lo,hi) \
149 150 151 152 153 154
  (Clongest)((sizeof(Cell) < sizeof(Clongest))		\
   ? (((UClongest)(lo))|(((UClongest)(hi))<<CELL_BITS)) \
   : (lo))

#define gforth_ud2ll(lo,hi) \
  (UClongest)((sizeof(Cell) < sizeof(Clongest))		\
anton's avatar
anton committed
155 156 157 158
   ? (((UClongest)(lo))|(((UClongest)(hi))<<CELL_BITS)) \
   : (lo))

#define gforth_ll2d(ll,lo,hi) \
159 160 161 162 163 164 165 166
  do { \
    Clongest _ll = (ll); \
    (lo) = (Cell)_ll; \
    (hi) = ((sizeof(Cell) < sizeof(Clongest)) \
            ? (_ll >> CELL_BITS) \
            : 0); \
  } while (0);

167
#define c_str2gforth_str(str,addr,u) \
168
    (addr) = (Cell) str; \
169
    (u) = (addr) ? strlen((char*)(addr)) : 0;
170

171
#define gforth_ll2ud(ll,lo,hi) \
anton's avatar
anton committed
172 173 174 175 176 177 178
  do { \
    UClongest _ll = (ll); \
    (lo) = (Cell)_ll; \
    (hi) = ((sizeof(Cell) < sizeof(Clongest)) \
            ? (_ll >> CELL_BITS) \
            : 0); \
  } while (0);
Bernd Paysan's avatar
Bernd Paysan committed
179

180
static int gforth_strs_i;
Bernd Paysan's avatar
Bernd Paysan committed
181
static void * gforth_strs[0x10] = { 0, 0, 0, 0,  0, 0, 0, 0,  0, 0, 0, 0,  0, 0, 0, 0 };
182 183 184 185 186

#define ROLLSTR(type,size)					   \
  type * str= malloc(sizeof(type)*(size));			   \
  gforth_strs_i++; gforth_strs_i &= 0x0F; 			   \
  if(gforth_strs[gforth_strs_i]) free(gforth_strs[gforth_strs_i]); \
Bernd Paysan's avatar
Bernd Paysan committed
187
  gforth_strs[gforth_strs_i]=(void*)str;
188 189 190

static Char * gforth_str2c(Char* addr, UCell u)
{
Bernd Paysan's avatar
Bernd Paysan committed
191 192 193 194 195 196 197 198
  if(addr == NULL) {
    return (Char*)u; // pass direct values
  } else {
    ROLLSTR(Char, u+1);
    memmove(str, addr, u);
    str[u]='\0'; // add zero terminator
    return str;
  }
199 200
}

201
static wchar_t * gforth_str2wc(Char* addr, UCell u)
202
{
Bernd Paysan's avatar
Bernd Paysan committed
203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234
  if(addr == NULL) {
    return (wchar_t*)u;
  } else {
    UCell i=0, c;
    Char x, y, z; // for further parts of the UTF-8 char
    Char* end=addr+u;
    ROLLSTR(wchar_t,u+1);
    while(addr<end) {
      switch((c=*addr++)) {
      case 0xC2 ... 0xDF: x = *addr++;
	c = ((c & 0x1F) << 6) | (x & 0x3F);
	// fprintf(stderr, "2c[%d]: %03x\n", i, c);
	break;
      case 0xE0 ... 0xEF: x = *addr++; y = *addr++;
	c = ((c & 0x0F) << 12) | ((x & 0x3F) << 6) | (y & 0x3F);
	// fprintf(stderr, "3c[%d]: %04x\n", i, c);
	break;
      case 0xF0 ... 0xF7: x = *addr++; y = *addr++; z = *addr++;
	c = ((c & 0x07) << 18) | ((x & 0x3F) << 12) | ((y & 0x3F) << 6) | (z & 0x3F);
	// fprintf(stderr, "4c[%d]: %05x\n", i, c);
	if(sizeof(wchar_t) < 4) {
	  /* this is surrogate territory; if the UTF-8 is well-formed,
	   * it's a surrogate in UTF-16 */
	  c -= 0x10000;
	  str[i++] = 0xD800 | ((c >> 10) & 0x3FF);
	  c = 0xDC00 | (c & 0x3FF);
	} break;
      default:
	// fprintf(stderr, "1c[%d]: %02x\n", i, c);
	break; // ASCII or invalid character
      }
      str[i++] = c;
235
    }
Bernd Paysan's avatar
Bernd Paysan committed
236 237
    str[i]=0; // add zero terminator
    return str;
238 239 240
  }
}

Bernd Paysan's avatar
Bernd Paysan committed
241
typedef Char hash_128[16];
242 243

#define GFSS 0x80 /* stack sizes */