xb2csol.h 10.8 KB
Newer Older
kollo's avatar
kollo committed
1
/* This header file is needed to compile output from xb2c */
kollo's avatar
kollo committed
2
/*  gcc delme.c -lx11basic -ldl -lm -lcurses -lncurses -lasound -lreadline -lX11 
kollo's avatar
kollo committed
3 4 5 6 7 8 9 10 11 12 13
 */

/* This file is part of X11BASIC, the basic interpreter for Unix/X
 * ============================================================
 * X11BASIC is free software and comes with NO WARRANTY - read the file
 * COPYING for details
 */

#include <stdlib.h>
#include <stdio.h>
#include <string.h>
kollo's avatar
kollo committed
14
#include <math.h>
kollo's avatar
kollo committed
15
#include <gmp.h>
kollo's avatar
kollo committed
16 17 18
#include <x11basic/x11basic.h>

#define BC_STACKLEN 512
kollo's avatar
kollo committed
19
#define PL_LEER     0x00
20
#define PL_KEY      0x45
kollo's avatar
kollo committed
21 22 23 24 25
#define PL_INT       1
#define PL_FLOAT     2
#define PL_ARBINT    3
#define PL_COMPLEX   5
#define PL_STRING    7
kollo's avatar
kollo committed
26

kollo's avatar
kollo committed
27 28 29 30 31 32
#define PL_ARRAY     8

#define PL_LABEL    0x20
#define PL_PROC     0x21
#define PL_IVAR     0x11
#define PL_FVAR     0x12
kollo's avatar
kollo committed
33

kollo's avatar
kollo committed
34 35
/* Variablen Typen (unsigned char)*/

kollo's avatar
kollo committed
36 37
#define TYPMASK           7

kollo's avatar
kollo committed
38 39 40
#define NOTYP             0
#define INTTYP            1
#define FLOATTYP          2
kollo's avatar
kollo committed
41 42 43 44
#define ARBINTTYP         3
#define COMPLEXTYP        5
#define STRINGTYP         7
#define ARRAYTYP          8
kollo's avatar
kollo committed
45 46
#define CONSTTYP       0x20
#define FILENRTYP       0x40
kollo's avatar
kollo committed
47

kollo's avatar
kollo committed
48 49 50
#define V_DYNAMIC 0
#define V_STATIC 1

kollo's avatar
kollo committed
51
/* X11-Basic needs these declarations:  */
kollo's avatar
kollo committed
52
#ifdef NOMAIN
kollo's avatar
kollo committed
53
extern int is_bytecode;
kollo's avatar
kollo committed
54 55 56 57 58
extern int programbufferlen;
extern char ifilename[];
extern char *programbuffer;
extern const char version[]; /* Version Number. */
extern const char vdate[];   /* Creation date.*/
kollo's avatar
kollo committed
59
extern char **program;    /* Other comments.  */
kollo's avatar
kollo committed
60 61 62 63 64 65
extern int prglen;
extern int datapointer;
extern PARAMETER *opstack;
extern PARAMETER *osp;
extern int verbose;
#else
kollo's avatar
kollo committed
66
extern int is_bytecode;
kollo's avatar
kollo committed
67
int programbufferlen;
kollo's avatar
kollo committed
68
char ifilename[]="dummy";     /* Program name.   Put some useful information here */
kollo's avatar
kollo committed
69
char *programbuffer;
kollo's avatar
kollo committed
70
const char version[]="1.24"; /* Version Number. Put some useful information here */
71
const char vdate[]="2016-01-01";   /* Creation date.  Put some useful information here */
kollo's avatar
kollo committed
72
char **program={"compiled by xb2c"};    /* Other comments. Put some useful information here */
kollo's avatar
kollo committed
73 74 75 76
int prglen=sizeof(program)/sizeof(char *);
extern int datapointer;
PARAMETER *opstack;
PARAMETER *osp;
kollo's avatar
kollo committed
77 78
int verbose;
#endif
kollo's avatar
kollo committed
79

kollo's avatar
kollo committed
80
int vm_comm(PARAMETER *sp,int i, int anzarg);
kollo's avatar
kollo committed
81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106


static inline void p2arbint(PARAMETER *p,ARBINT a) {
  switch(p->typ) {
  case PL_INT:     mpz_set_si(a,p->integer);break; 
  case PL_FLOAT:   
  case PL_COMPLEX: mpz_set_d(a,p->real);break;
  case PL_ARBINT:  mpz_set(a,*(ARBINT *)p->pointer);break;
  default: xberror(46,""); /*  Parameter %s falsch, keine Number */
  }
}

inline static void cast_to_arbint(PARAMETER *sp) {
  if(sp->typ==PL_LEER ||sp->typ==PL_ARBINT) return;
  ARBINT a;
  mpz_init(a);
  p2arbint(sp,a);
  free_parameter(sp);
  sp->pointer=malloc(sizeof(ARBINT));
  mpz_init(*(ARBINT *)sp->pointer);
  mpz_set(*(ARBINT *)sp->pointer,a);
  sp->typ=PL_ARBINT;
  mpz_clear(a);
}


kollo's avatar
kollo committed
107
void free_parameter(PARAMETER *p);
kollo's avatar
kollo committed
108
  /* Initialize the x11basic-library */
kollo's avatar
kollo committed
109
#define MAIN_INIT  programbufferlen=0; programbuffer=NULL; x11basicStartup(); set_input_mode(1,0); \
kollo's avatar
kollo committed
110 111 112
  atexit(reset_input_mode); \
  param_anzahl=anzahl; \
  param_argumente=argumente; \
kollo's avatar
kollo committed
113
  osp=opstack=calloc(BC_STACKLEN,sizeof(PARAMETER)); \
kollo's avatar
kollo committed
114
  programbufferlen=prglen=pc=sp=0; is_bytecode=1;
kollo's avatar
kollo committed
115 116 117


#define CLEAR {int a,j; a=((int)opstack-(int)osp)/sizeof(PARAMETER); \
kollo's avatar
kollo committed
118
      if(a) { opstack=osp; for(j=0;j<a;j++)  free_parameter(&opstack[j]); } }
kollo's avatar
kollo committed
119 120 121 122 123 124 125 126 127 128 129

#define NOOP
#define RESTORE(a) datapointer=a
#define PUSH0    opstack->integer=0; opstack->typ=PL_INT; opstack++
#define PUSH1    opstack->integer=1; opstack->typ=PL_INT; opstack++
#define PUSH2    opstack->integer=2; opstack->typ=PL_INT; opstack++
#define PUSHM1   opstack->integer=-1; opstack->typ=PL_INT; opstack++
#define PUSHB(a) opstack->integer=a; opstack->typ=PL_INT; opstack++
#define PUSHI(a) opstack->integer=a; opstack->typ=PL_INT; opstack++
#define PUSHW(a) opstack->integer=a; opstack->typ=PL_INT; opstack++
#define PUSHF(a) opstack->real=a; opstack->typ=PL_FLOAT; opstack++
kollo's avatar
kollo committed
130 131
#define PUSHC(a,b) opstack->real=a;opstack->imag=b; opstack->typ=PL_COMPLEX; opstack++

kollo's avatar
kollo committed
132
#define PUSHX(a) opstack->integer=strlen(a); opstack->pointer=strdup(a); opstack->typ=PL_KEY; opstack++
kollo's avatar
kollo committed
133
#define PUSHK(a) opstack->integer=0; opstack->pointer=NULL; opstack->arraytyp=a; opstack->typ=PL_KEY; opstack++
kollo's avatar
kollo committed
134
/* TODO: binary data in Strings*/
kollo's avatar
kollo committed
135
#define PUSHS(a) opstack->integer=strlen(a); opstack->pointer=strdup(a); opstack->typ=PL_STRING; opstack++
kollo's avatar
kollo committed
136 137
/* TODO: Array constant */
#define PUSHA(a,l) opstack->integer=l; opstack->pointer=strdup(a); opstack->typ=PL_ARRAY; opstack++
kollo's avatar
kollo committed
138
#define PUSHLEER opstack->typ=PL_LEER; opstack++
kollo's avatar
kollo committed
139
#define POP      opstack--; free_parameter(opstack)
kollo's avatar
kollo committed
140 141
#define COUNT    opstack->integer=((int)opstack-(int)osp)/sizeof(PARAMETER); opstack->typ=PL_INT; opstack++
#define EVAL     opstack--; kommando(opstack->pointer); free(opstack->pointer)
kollo's avatar
kollo committed
142 143
#define PUSHARRAYELEM(a,b) opstack+=vm_pusharrayelem(a,opstack,b)
#define ZUWEISINDEX(a,b) opstack+=vm_zuweisindex(a,opstack,b)
kollo's avatar
kollo committed
144 145
#define PUSHV(a)  push_v(opstack,&variablen[a]); opstack++
// define PUSHV(a) opstack+=vm_pushv(a,opstack)
kollo's avatar
kollo committed
146 147 148
#define PUSHVV(a) opstack+=vm_pushvv(a,opstack)
#define PUSHVVI(a,b) opstack+=vm_pushvvi(a,opstack,b)
#define ZUWEIS(a) opstack+=vm_zuweis(a,opstack)
kollo's avatar
kollo committed
149 150
#define ZUWEISi(a) *(variablen[a].pointer.i)=(--opstack)->integer
#define ZUWEISf(a) *(variablen[a].pointer.f)=(--opstack)->real
kollo's avatar
kollo committed
151
#define ZUWEISc(a) *(variablen[a].pointer.c)=*((COMPLEX *)&((--opstack)->real))
kollo's avatar
kollo committed
152

kollo's avatar
kollo committed
153 154
#define LOCAL(a)  do_local(a,sp)
#define MOD      opstack+=vm_mod(opstack)
kollo's avatar
kollo committed
155 156 157 158 159 160 161 162 163
#define NOT      vm_not(opstack)
#define NOTi     (opstack-1)->integer=~(opstack-1)->integer
#define X2I      if((opstack-1)->typ!=PL_INT) {(opstack-1)->integer=(int)(opstack-1)->real; (opstack-1)->typ=PL_INT;}
#define X2AI     cast_to_arbint(opstack-1)
#define X2F      if((opstack-1)->typ==PL_INT) {(opstack-1)->real=(double)(opstack-1)->integer;} (opstack-1)->typ=PL_FLOAT
#define I2F      (opstack-1)->real=(double)(opstack-1)->integer; (opstack-1)->typ=PL_FLOAT
#define I2FILE   (opstack-1)->typ=PL_FILENR
#define X2C      if((opstack-1)->typ==PL_INT) {(opstack-1)->real=(double)(opstack-1)->integer;} if((opstack-1)->typ!=PL_COMPLEX) {(opstack-1)->imag=0;(opstack-1)->typ=PL_COMPLEX;}
#define F2C      (opstack-1)->imag=0;(opstack-1)->typ=PL_COMPLEX
kollo's avatar
kollo committed
164

kollo's avatar
kollo committed
165 166 167 168 169 170 171 172
#define NEG      vm_neg(opstack)
#define EXCH     *opstack=opstack[-1];opstack[-1]=opstack[-2];opstack[-2]=*opstack

#define DUP      opstack+=vm_dup(opstack)
#define EQUAL    opstack+=vm_equal(opstack)
#define LESS     opstack+=vm_less(opstack)
#define GREATER  opstack+=vm_greater(opstack)
#define POW      opstack+=vm_pow(opstack)
kollo's avatar
kollo committed
173 174 175
#define DIV      opstack+=vm_div(opstack)
#define DIVf     opstack--;(opstack-1)->real/=opstack->real
#define DIVc     opstack--;*(COMPLEX *)&((opstack-1)->real)=complex_div(*(COMPLEX *)&((opstack-1)->real),*(COMPLEX *)&((opstack)->real))
kollo's avatar
kollo committed
176
#define MUL      opstack+=vm_mul(opstack)
kollo's avatar
kollo committed
177 178
#define MULi     opstack--;(opstack-1)->integer*=opstack->integer
#define MULf     opstack--;(opstack-1)->real*=opstack->real
kollo's avatar
kollo committed
179
#define MULc     opstack--;*(COMPLEX *)&((opstack-1)->real)=complex_mul(*(COMPLEX *)&((opstack-1)->real),*(COMPLEX *)&((opstack)->real))
kollo's avatar
kollo committed
180
#define SUB      opstack+=vm_sub(opstack)
kollo's avatar
kollo committed
181 182
#define SUBi     opstack--;(opstack-1)->integer-=opstack->integer
#define SUBf     opstack--;(opstack-1)->real-=opstack->real
kollo's avatar
kollo committed
183 184 185 186 187 188
#define AND      opstack+=vm_and(opstack)
#define ANDi     opstack--;(opstack-1)->integer&=opstack->integer
#define OR       opstack+=vm_or(opstack)
#define ORi      opstack--;(opstack-1)->integer|=opstack->integer
#define XOR      opstack+=vm_xor(opstack)
#define XORi     opstack--;(opstack-1)->integer^=opstack->integer
kollo's avatar
kollo committed
189

kollo's avatar
kollo committed
190
#define ADD      opstack+=vm_add(opstack)
kollo's avatar
kollo committed
191 192
#define ADDi     opstack--;(opstack-1)->integer+=opstack->integer
#define ADDf     opstack--;(opstack-1)->real+=opstack->real
kollo's avatar
kollo committed
193
#define ADDc     opstack--;(opstack-1)->real+=opstack->real;(opstack-1)->imag+=opstack->imag
kollo's avatar
kollo committed
194 195 196 197 198 199 200
#define ADDs     opstack--; {\
                 int l=(opstack-1)->integer;char *p=(opstack-1)->pointer;\
		 (opstack-1)->integer+=opstack->integer;\
		 (opstack-1)->pointer=malloc((opstack-1)->integer+1);\
		 memcpy((opstack-1)->pointer,p,l);free(p);\
		 memcpy((opstack-1)->pointer+l,opstack->pointer,opstack->integer+1);\
		 } free(opstack->pointer)
kollo's avatar
kollo committed
201 202 203 204 205 206 207
#define PUSHASYS(a) opstack+=vm_asysvar(opstack,a)
#define PUSHSSYS(a) opstack+=vm_ssysvar(opstack,a)
#define PUSHSYS(a)  opstack+=vm_sysvar(opstack,a)
#define PUSHCOMM(a,n) opstack+=vm_comm(opstack,a,n)
#define PUSHFUNC(a,n) opstack+=vm_func(opstack,a,n)
#define PUSHSFUNC(a,n) opstack+=vm_sfunc(opstack,a,n)

kollo's avatar
kollo committed
208 209 210 211 212
#define PUSHLABEL(a) opstack->integer=(int)a; opstack->arraytyp=3; opstack->typ=PL_LABEL; opstack++
#define PUSHPROC(a)  opstack->integer=(int)a; opstack->arraytyp=3; opstack->typ=PL_PROC; opstack++



kollo's avatar
kollo committed
213 214 215 216 217 218 219
/* simplified commands */

#define COMM_BEEP putchar('\007')
#define COMM_BELL putchar('\007')
#define COMM_VSYNC activate()
#define COMM_SHOWPAGE activate()
#define COMM_END puts("done.");batch=0
kollo's avatar
kollo committed
220 221
#define COMM_INC opstack--;if(opstack->typ==PL_FVAR) (*((double *)opstack->pointer))++;  else if(opstack->typ==PL_IVAR) (*((int *)opstack->pointer))++
#define COMM_DEC opstack--;if(opstack->typ==PL_FVAR) (*((double *)opstack->pointer))--;  else if(opstack->typ==PL_IVAR) (*((int *)opstack->pointer))--
kollo's avatar
kollo committed
222

kollo's avatar
kollo committed
223 224
/* conditional helpers*/
#define JUMPIFZERO if((--opstack)->integer==0) goto
kollo's avatar
kollo committed
225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264

/* simplified functions */

#define PFUNC_ABS (opstack-1)->real=fabs((opstack-1)->real)
#define PFUNC_ACOS (opstack-1)->real=acos((opstack-1)->real)
#define PFUNC_ACOSH (opstack-1)->real=acosh((opstack-1)->real)
#define PFUNC_ASIN (opstack-1)->real=asin((opstack-1)->real)
#define PFUNC_ASINH (opstack-1)->real=asinh((opstack-1)->real)
#define PFUNC_ATAN (opstack-1)->real=atan((opstack-1)->real)
#define PFUNC_ATN (opstack-1)->real=atan((opstack-1)->real)
#define PFUNC_ATANH (opstack-1)->real=atanh((opstack-1)->real)

#define PFUNC_CBRT (opstack-1)->real=cbrt((opstack-1)->real)
#define PFUNC_CEIL (opstack-1)->real=ceil((opstack-1)->real)
#define PFUNC_COS (opstack-1)->real=cos((opstack-1)->real)
#define PFUNC_COSH (opstack-1)->real=cosh((opstack-1)->real)

#define PFUNC_EXP (opstack-1)->real=exp((opstack-1)->real)
#define PFUNC_EXPM1 (opstack-1)->real=expm1((opstack-1)->real)

#define PFUNC_FLOOR (opstack-1)->real=floor((opstack-1)->real)

#define PFUNC_HYPOT (opstack-1)->real=hypot((opstack-1)->real)

#define PFUNC_LN (opstack-1)->real=log((opstack-1)->real)
#define PFUNC_LOG (opstack-1)->real=log((opstack-1)->real)
#define PFUNC_LOG10 (opstack-1)->real=log10((opstack-1)->real)
#define PFUNC_LOG1P (opstack-1)->real=log1p((opstack-1)->real)
#define PFUNC_LOGB (opstack-1)->real=logb((opstack-1)->real)

#define PFUNC_RAND (opstack-1)->real=rand((opstack-1)->real)

#define PFUNC_SIN (opstack-1)->real=sin((opstack-1)->real)
#define PFUNC_SINH (opstack-1)->real=sinh((opstack-1)->real)

#define PFUNC_SQR (opstack-1)->real=sqrt((opstack-1)->real)
#define PFUNC_SQRT (opstack-1)->real=sqrt((opstack-1)->real)

#define PFUNC_TAN (opstack-1)->real=tan((opstack-1)->real)
#define PFUNC_TANH (opstack-1)->real=tanh((opstack-1)->real)
kollo's avatar
kollo committed
265