xbasic.c 41 KB
Newer Older
kollo's avatar
kollo committed
1
/* XBASIC.C
kollo's avatar
kollo committed
2

kollo's avatar
kollo committed
3
   (c) Markus Hoffmann
kollo's avatar
kollo committed
4 5


kollo's avatar
kollo committed
6 7
   ##     ##   #   #        ######
    ##   ##   ##  ##        ##   ##                    ##
kollo's avatar
kollo committed
8
     ## ##   ### ###        ##   ##
kollo's avatar
kollo committed
9 10 11 12 13
      ###     ##  ## #####  #####     #####    #####  ####   ####
     ## ##    ##  ##        ##   ##       ##  ##       ##   ##  ##
    ##   ##   ##  ##        ##   ##   ######   ####    ##   ##
   ##     ##  ##  ##        ##   ##  ##   ##      ##   ##   ##  ##
   ##     ##  ##  ##        ######    ######  #####   ####   ####
kollo's avatar
kollo committed
14

kollo's avatar
kollo committed
15 16


17
                       VERSION 1.25
kollo's avatar
kollo committed
18

kollo's avatar
kollo committed
19
            (C) 1997-2017 by Markus Hoffmann
kollo's avatar
kollo committed
20 21
              (kollo@users.sourceforge.net)
            (http://x11-basic.sourceforge.net/)
kollo's avatar
kollo committed
22

kollo's avatar
kollo committed
23
 **  Erstellt: Aug. 1997   von Markus Hoffmann				   **
kollo's avatar
kollo committed
24
 **  letzte Bearbeitung: 01/2017  von Markus Hoffmann		   **
kollo's avatar
kollo committed
25
*/
kollo's avatar
kollo committed
26

kollo's avatar
kollo committed
27
 /* This file is part of X11BASIC, the basic interpreter for Unix/X
kollo's avatar
kollo committed
28
 * ============================================================
kollo's avatar
kollo committed
29 30
 * X11BASIC is free software and comes with NO WARRANTY - read the file
 * COPYING for details
kollo's avatar
kollo committed
31
 */
kollo's avatar
kollo committed
32 33 34



kollo's avatar
kollo committed
35 36
#include <stdio.h>
#include <stdlib.h>
37
#include <stdint.h>
kollo's avatar
kollo committed
38
#include <string.h>
kollo's avatar
kollo committed
39 40 41
#if defined(__CYGWIN__) || defined(__MINGW32__)
#include <windows.h>
#endif
kollo's avatar
kollo committed
42 43


kollo's avatar
kollo committed
44 45 46 47 48
#include <math.h>
#include <errno.h>
#include <time.h>
#include <ctype.h>

kollo's avatar
kollo committed
49
#include "defs.h"
kollo's avatar
kollo committed
50 51
#include "x11basic.h"
#include "variablen.h"
kollo's avatar
kollo committed
52
#include "xbasic.h"
53
#include "memory.h"
kollo's avatar
kollo committed
54
#include "type.h"
kollo's avatar
kollo committed
55 56
#include "parser.h"
#include "parameter.h"
kollo's avatar
kollo committed
57 58
#include "kommandos.h"
#include "gkommandos.h"
kollo's avatar
kollo committed
59
#include "io.h"
kollo's avatar
kollo committed
60 61 62
#include "file.h"
#include "array.h"
#include "x11basic.h"
kollo's avatar
kollo committed
63
#include "wort_sep.h"
kollo's avatar
kollo committed
64 65
#include "bytecode.h"
#include "virtual-machine.h"
kollo's avatar
kollo committed
66 67
#include "graphics.h"
#include "window.h"
kollo's avatar
kollo committed
68
#include "number.h"
kollo's avatar
kollo committed
69
#include "functions.h"
kollo's avatar
kollo committed
70 71


kollo's avatar
kollo committed
72 73 74 75 76
const char libversion[]=VERSION;           /* Programmversion           */
const char libvdate[]=VERSION_DATE;
extern const char version[];
extern const char libvdate[];

kollo's avatar
kollo committed
77 78
#ifdef CONTROL
const char xbasic_name[]="csxbasic";
kollo's avatar
kollo committed
79
#elif defined DOOCS
kollo's avatar
kollo committed
80
const char xbasic_name[]="doocsxbasic";
kollo's avatar
kollo committed
81
#elif defined TINE
kollo's avatar
kollo committed
82
const char xbasic_name[]="tinexbasic";
kollo's avatar
kollo committed
83
#elif defined USE_SDL
kollo's avatar
kollo committed
84 85
const char xbasic_name[]="sdlxbasic";
#else
kollo's avatar
kollo committed
86
const char xbasic_name[]="xbasic";
kollo's avatar
kollo committed
87
#endif
kollo's avatar
kollo committed
88
int pc=0,sp=0,echoflag=0,batch=0,errcont=0,breakcont=0,everyflag=0;
kollo's avatar
kollo committed
89 90
int errorpc=-1,errorpctype=0,breakpc=-1,breakpctype=0;
int everytime=0,alarmpc=-1,alarmpctype=0;
kollo's avatar
kollo committed
91

kollo's avatar
kollo committed
92 93
int stack[STACKSIZE];

kollo's avatar
kollo committed
94

95
#if SIZEOF_VOID_P == 8
96 97 98 99
void *pointerbase=NULL;
#endif


kollo's avatar
kollo committed
100
/* fuer die Dateiverwaltung     */
kollo's avatar
kollo committed
101
FILEINFO filenr[ANZFILENR];
kollo's avatar
kollo committed
102 103
static int *linetable=NULL;   /* for correctly count splitted lines*/

kollo's avatar
kollo committed
104

kollo's avatar
kollo committed
105
PARAMETER returnvalue;
kollo's avatar
kollo committed
106 107

int param_anzahl;
kollo's avatar
kollo committed
108
char **param_argumente=NULL;
kollo's avatar
kollo committed
109 110 111

int usewindow=DEFAULTWINDOW;

kollo's avatar
kollo committed
112
void free_pcode(int l);
kollo's avatar
kollo committed
113

kollo's avatar
kollo committed
114 115
static int add_label(char *name,int zeile,int dataptr);
static int add_proc(char *name,char *pars,int zeile,int typ);
kollo's avatar
kollo committed
116

kollo's avatar
kollo committed
117
static int oldprglen=0;
kollo's avatar
kollo committed
118

kollo's avatar
kollo committed
119 120
extern char ifilename[];

kollo's avatar
kollo committed
121 122 123 124 125 126 127 128 129 130
/*return the original line (accounting for splitted lines) */
int original_line(int i) {
  if(linetable==NULL || i<0) return i;
  int j;
  int a=i;
  for(j=0;j<i;j++) a+=linetable[j];
  return a;
}


kollo's avatar
kollo committed
131 132 133 134 135 136 137
/* Bytecode spezifica. */

int is_bytecode=0;
static char *stringseg;
BYTECODE_SYMBOL *symtab;

static void do_relocation(char *adr,unsigned char *fixup, int l) {
kollo's avatar
kollo committed
138
  int i=0;
139
  uint32_t ll;
kollo's avatar
kollo committed
140 141
 // printf("Relocation table:\n");
 // memdump(fixup,l);
kollo's avatar
kollo committed
142 143 144 145 146
  while(i<l) {
    if(fixup[i]==0) break;
    else if(fixup[i]==1) adr+=254;
    else {
      adr+=fixup[i];
147
      memcpy(&ll,adr,sizeof(uint32_t));
kollo's avatar
kollo committed
148 149 150
      #ifdef ATARI
        LWSWAP((short *)&ll);
      #endif
151
      ll+=POINTER2INT(adr);
kollo's avatar
kollo committed
152 153 154
      #ifdef ATARI
        LWSWAP((short *)&ll);
      #endif
155
      memcpy(adr,&ll,sizeof(uint32_t));
kollo's avatar
kollo committed
156
    }
kollo's avatar
kollo committed
157
  }
kollo's avatar
kollo committed
158 159 160 161 162 163 164 165 166 167 168 169 170
}
/* We assume that the segments are in following order: 
   HEADER
   TEXT
   RODATA
   SDATA
   DATA
   BSS  --- STRINGS  
        --- SYMBOL
	--- RELOCATION
	*/

char *bytecode_init(char *adr) {
kollo's avatar
kollo committed
171
  int i,a,typ;
kollo's avatar
kollo committed
172 173
  char *name;
  char *bsseg;
kollo's avatar
kollo committed
174 175 176 177
  unsigned char *fixup;   /* Relocation information */
//#ifdef ANDROID
//  char buffer[256];
//#endif
kollo's avatar
kollo committed
178 179 180 181

  /* Ueberpruefe ob ein gueltiger Header dabei ist und setze databuffer */
  if(adr[0]==BC_BRAs && adr[1]==sizeof(BYTECODE_HEADER)-2) {
    BYTECODE_HEADER *bytecode=(BYTECODE_HEADER *)adr;
kollo's avatar
kollo committed
182 183 184 185

    clear_program();
    free_pcode(prglen);
    prglen=pc=0;
kollo's avatar
kollo committed
186
    is_bytecode=1;
kollo's avatar
kollo committed
187 188 189 190
//#ifdef ANDROID
//     sprintf(buffer,"Bytecode header found (V.%x)\n",bytecode->version);
//     backlog(buffer);
//#endif
kollo's avatar
kollo committed
191
    if(bytecode->version!=BC_VERSION) {
kollo's avatar
kollo committed
192 193
      printf("ERROR: This bytecode was compiled for a different version (V.%04x) of "
      "X11-Basic.\n Please consider to recompile it from the .bas file.\n",bytecode->version);
kollo's avatar
kollo committed
194 195 196 197 198 199
      return(NULL);
    }
        
    /* Set up the data buffer */
    databuffer=adr+bytecode->textseglen+bytecode->rodataseglen+sizeof(BYTECODE_HEADER);
    databufferlen=bytecode->sdataseglen;
kollo's avatar
kollo committed
200 201 202 203
//#ifdef ANDROID
//    sprintf(buffer,"Databuffer $%08x contains: <%s>\n",(unsigned int)databuffer,databuffer);
//    backlog(buffer);
//#endif
kollo's avatar
kollo committed
204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220
    rodata=&adr[sizeof(BYTECODE_HEADER)+bytecode->textseglen];
    bsseg=stringseg=&adr[sizeof(BYTECODE_HEADER)+
                 bytecode->textseglen+
		 bytecode->rodataseglen+
		 bytecode->sdataseglen+
		 bytecode->dataseglen];

    /* Jetzt Variablen anlegen.*/
    symtab=(BYTECODE_SYMBOL *)(adr+sizeof(BYTECODE_HEADER)+
                                   bytecode->textseglen+
		                   bytecode->rodataseglen+
		                   bytecode->sdataseglen+
				   bytecode->dataseglen+
				   bytecode->stringseglen);
    a=bytecode->symbolseglen/sizeof(BYTECODE_SYMBOL);
    if(a>0) {
      for(i=0;i<a;i++) {
kollo's avatar
kollo committed
221 222 223 224
	#ifdef ATARI
	  LWSWAP((short *)&symtab[i].name);
	  LWSWAP((short *)&symtab[i].adr);
	#endif
kollo's avatar
kollo committed
225 226
        if(symtab[i].typ==STT_OBJECT) {
	  typ=symtab[i].subtyp;
kollo's avatar
kollo committed
227 228 229
	  if(symtab[i].name) {
	    name=&stringseg[symtab[i].name];
          } else {
kollo's avatar
kollo committed
230
	    name=malloc(32);  /*TODO: Das muss irgendwann wieder freigegeben werden ....*/
kollo's avatar
kollo committed
231
	    sprintf(name,"VAR_%x",i);
kollo's avatar
kollo committed
232
          }
kollo's avatar
kollo committed
233
	  
kollo's avatar
kollo committed
234 235 236
	  /*Hier erstmal nur int und float im bss ablegen, da noch nicht geklaert ist, 
	  wie wir strings und arrays hier initialisieren koennen ohne die symboltabelle 
	  zu ueberschreiben*/
kollo's avatar
kollo committed
237 238 239 240
//#if defined ANDROID
//    sprintf(buffer,"Symbol: <%s> $%04x %08x ",name,typ,symtab[i].adr);
//    backlog(buffer);
//#endif	  
kollo's avatar
kollo committed
241 242 243
	  if(typ&ARRAYTYP)        add_variable(name,ARRAYTYP,typ&(~ARRAYTYP),V_DYNAMIC,NULL);
	  else if(typ==STRINGTYP) add_variable(name,typ,0,V_DYNAMIC,NULL);
	  else                    add_variable(name,typ,0,V_STATIC,bsseg+symtab[i].adr);
kollo's avatar
kollo committed
244 245 246 247
//#ifdef ANDROID	  
//    sprintf(buffer,"BSSSEG auf %08x ",bsseg);
//    backlog(buffer);
//#endif
kollo's avatar
kollo committed
248 249 250
        }  
      }
    }
kollo's avatar
kollo committed
251 252 253 254 255
//#ifdef ANDROIOD    
//    sprintf(buffer,"%d variables.\n",anzvariablen);
//    backlog(buffer);
//#endif
#if DEBUG
kollo's avatar
kollo committed
256 257
    printf("%d variables.\n",anzvariablen);
    c_dump(NULL,0);
kollo's avatar
kollo committed
258 259
#endif
    fixup=(unsigned char *)(adr+sizeof(BYTECODE_HEADER)+
kollo's avatar
kollo committed
260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278
                       bytecode->textseglen+
		       bytecode->rodataseglen+
		       bytecode->sdataseglen+
		       bytecode->dataseglen+
		       bytecode->stringseglen+
		       bytecode->symbolseglen);
    if((bytecode->flags&EXE_REL)==EXE_REL && bytecode->relseglen>0) 
      do_relocation(adr,fixup,bytecode->relseglen);

   /*Now: clear bss segment. This will probably overwrite symbol table and strings and relocation info*/
    if(bytecode->bssseglen>0) bzero(bsseg,bytecode->bssseglen);
#ifdef ANDROID
    backlog("bytecode_init done.");
#endif
    return(adr);
  } else {
    printf("VM: ERROR, file format not recognized. $%02x $%02x\n",adr[0],adr[1]);
    return(NULL);
  }
kollo's avatar
kollo committed
279 280
}

kollo's avatar
kollo committed
281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307
int fix_bytecode_header(BYTECODE_HEADER *bytecode) {
  if(((char *)bytecode)[0]==BC_BRAs && ((char *)bytecode)[1]==sizeof(BYTECODE_HEADER)-2) {
  #if DEBUG 
    printf("Bytecode header found (V.%x)\n",bytecode->version);
  #endif
  #ifdef ATARI
  WSWAP((char *)&bytecode->version);
  #endif
  if(bytecode->version!=BC_VERSION) {
    printf("ERROR: This bytecode was compiled for a different version of "
    "X11-Basic.\n Please consider to recompile it from the .bas file.\n");
    return(-1);
  }
#ifdef ATARI
  LWSWAP((short *)&bytecode->textseglen);
  LWSWAP((short *)&bytecode->rodataseglen);
  LWSWAP((short *)&bytecode->sdataseglen);
  LWSWAP((short *)&bytecode->dataseglen);
  LWSWAP((short *)&bytecode->bssseglen);
  LWSWAP((short *)&bytecode->symbolseglen);
  LWSWAP((short *)&bytecode->stringseglen);
  LWSWAP((short *)&bytecode->relseglen);
  WSWAP((char *)&bytecode->flags);
#endif
  return(0);
  } else return(-1);
}
kollo's avatar
kollo committed
308 309 310 311 312



/* Routine zum Laden eines Programms */

kollo's avatar
kollo committed
313
int mergeprg(const char *fname) {
kollo's avatar
kollo committed
314
  int i,len;
kollo's avatar
kollo committed
315
  char *pos;
kollo's avatar
kollo committed
316
  FILE *dptr;
kollo's avatar
kollo committed
317 318
  /* Filelaenge rauskriegen */

kollo's avatar
kollo committed
319
  dptr=fopen(fname,"rb"); len=lof(dptr); fclose(dptr);
kollo's avatar
kollo committed
320
  programbuffer=realloc(programbuffer,programbufferlen+len+1);
kollo's avatar
kollo committed
321 322 323 324 325 326 327 328
  #ifdef ATARI
    if(programbuffer==NULL) {
      perror("malloc");
      printf("ERROR: Need at least %d Bytes free memory.\n",programbufferlen+len+1);
      sleep(5);
      exit(-1);
    } else printf("MERGE: programbuffer=%p len=%d\n",programbuffer,programbufferlen+len+1);
  #endif
kollo's avatar
kollo committed
329 330 331
  bload(fname,programbuffer+programbufferlen,len);
  programbufferlen+=len;

kollo's avatar
kollo committed
332 333 334 335 336 337 338 339 340

/* Hier jetzt pr"ufen, ob es sich um eine bytecode-Datei handelt.
   wenn nicht, versuche sie zu interpretieren...*/

  /* Ueberpruefe ob ein gueltiger Header dabei ist */

  if(programbuffer[0]==BC_BRAs && programbuffer[1]==sizeof(BYTECODE_HEADER)-2) {
    BYTECODE_HEADER *bytecode=(BYTECODE_HEADER *)programbuffer;

kollo's avatar
kollo committed
341
    if(fix_bytecode_header((BYTECODE_HEADER *)programbuffer)) return(-1);
kollo's avatar
kollo committed
342 343 344 345 346 347 348 349 350 351 352 353 354 355 356
    
    /* Sicherstellen, dass der Speicherberiech auch gross genug ist fuer bss segment*/
    if(bytecode->bssseglen>bytecode->relseglen+bytecode->stringseglen+bytecode->symbolseglen) {
      programbufferlen+=bytecode->bssseglen-bytecode->stringseglen-bytecode->symbolseglen;
      programbuffer=realloc(programbuffer,programbufferlen);
    }
    
    if(bytecode_init(programbuffer)) return(0);
    return(-1); /* stimmt was nicht. */
  } else {
    
   /* Zeilenzahl herausbekommen */
    pos=programbuffer;
    oldprglen=prglen;
    i=prglen=0;
kollo's avatar
kollo committed
357 358
    
    /*Erster Durchgang */
kollo's avatar
kollo committed
359
    while(i<programbufferlen) {
kollo's avatar
kollo committed
360 361 362 363
      if(i<programbufferlen-1 && programbuffer[i]=='\r' && programbuffer[i+1]=='\n') {  /*DOS WINDOWS line ending behandeln.*/
        programbuffer[i]='\n';
	programbuffer[i+1]=2;
      }
kollo's avatar
kollo committed
364
      if(i>0 && programbuffer[i]=='\n' && programbuffer[i-1]=='\\') {
kollo's avatar
kollo committed
365
        programbuffer[i]=1;   /* Marker */
kollo's avatar
kollo committed
366 367 368
        programbuffer[i-1]=' ';
      } else if(programbuffer[i]==0 || programbuffer[i]=='\n') {
        programbuffer[i]=0;
kollo's avatar
kollo committed
369 370 371 372
	prglen++;
      } else if(programbuffer[i]==9) programbuffer[i]=' '; /* TABs entfernen*/
      i++;
    }
kollo's avatar
kollo committed
373 374
    if(i>0 && programbuffer[i-1]!=0) prglen++;  /*letzte Zeile hatte kein \n*/
    
kollo's avatar
kollo committed
375 376 377
    program=(char **)realloc(program,prglen*sizeof(char *));  /*Array mit Zeilenpointern*/
    linetable=realloc(linetable,prglen*sizeof(int));
    bzero(linetable,prglen*sizeof(int));
kollo's avatar
kollo committed
378
 
kollo's avatar
kollo committed
379 380 381 382 383 384 385 386 387

    /* Zweiter Durchgang */

    
    prglen=i=0;
    while(i<programbufferlen) {
      if(programbuffer[i]==1) {
        programbuffer[i]=' '; /* Marker entfernen*/
	linetable[prglen]++;
kollo's avatar
kollo committed
388 389 390 391 392 393
	if(i<programbufferlen+1 &&  programbuffer[i+1]==2) {
	  programbuffer[i+1]=' '; /* Marker entfernen*/
	}
      } else if(programbuffer[i]==2) {
        programbuffer[i]=0; /* Marker entfernen*/
	pos++;  // alternativ: pos=programbuffer+i+1;
kollo's avatar
kollo committed
394
      } else if(programbuffer[i]==0) {
kollo's avatar
kollo committed
395 396
        program[prglen++]=pos;
        pos=programbuffer+i+1;
kollo's avatar
kollo committed
397
      }
kollo's avatar
kollo committed
398 399
      i++;
    }
kollo's avatar
kollo committed
400 401 402 403
    if((pos-programbuffer)<programbufferlen) {
      program[prglen++]=pos;  /* Potenzielle letzte Zeile ohne \n */
      programbuffer[i]=0; /*stelle sicher dass die letzte Zeile durch ein 0 beendet ist*/
    }
kollo's avatar
kollo committed
404
    return(init_program(prglen));
kollo's avatar
kollo committed
405
  }
kollo's avatar
kollo committed
406
}
kollo's avatar
kollo committed
407

kollo's avatar
kollo committed
408 409


kollo's avatar
kollo committed
410
static int find_comm_guess(const char *w1,int *guessa,int *guessb) {
kollo's avatar
kollo committed
411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428
  int i=0,a=anzcomms-1,b;
  /* Kommandoliste durchsuchen, moeglichst effektiv ! */
  for(b=0; b<strlen(w1); b++) {
    while(w1[b]>(comms[i].name)[b] && i<a) i++;
    while(w1[b]<(comms[a].name)[b] && a>i) a--;
    if(i==a) break;
  }
  *guessa=i;
  *guessb=a;
  if((i==a && strncmp(w1,comms[i].name,strlen(w1))==0) ||
     (i!=a && strcmp(w1,comms[i].name)==0) ) {
#ifdef DEBUG
      if(b<strlen(w1)) printf("Command %s completed --> %s\n",w1,comms[i].name);
#endif
     return(i);
  }
  return(-1);
}
kollo's avatar
kollo committed
429

kollo's avatar
kollo committed
430

kollo's avatar
kollo committed
431

kollo's avatar
kollo committed
432 433 434 435 436 437 438 439 440

/*Entfernt ein Programm und alle Strukturen/Variablen aus dem Speicher, 
so dass ein neues Programm (bas oder bytecode) geladen werden kann. */

void clear_program() {

/* Stack aufraumen und Variablen entfernen */

  restore_all_locals();  /* sp=0 */
kollo's avatar
kollo committed
441
  remove_all_variables();
kollo's avatar
kollo committed
442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458

  if(is_bytecode) {

  } else {
    if(databuffer) free(databuffer);    
  }
  is_bytecode=0;
  databuffer=NULL;
  databufferlen=0;
  datapointer=0;
  clear_labelliste();
  clear_procliste();
}




kollo's avatar
kollo committed
459 460 461 462 463 464
/*****************************************************

Programmvorbereitung und precompilation

******************************************************/

kollo's avatar
kollo committed
465
int init_program(int prglen) {
kollo's avatar
kollo committed
466
  char *expr,*pos2,*pos3,*buffer=NULL,*zeile=NULL;  
kollo's avatar
kollo committed
467
  int i,j,len,typ;
kollo's avatar
kollo committed
468 469
  clear_program();
  free_pcode(oldprglen);
kollo's avatar
kollo committed
470

kollo's avatar
kollo committed
471
  init_pcode(prglen); /*Speicher für pcode allozieren und mit 0 füllen */ 
kollo's avatar
kollo committed
472
  
kollo's avatar
kollo committed
473
  /* Label-, Procedur- und Variablenliste Erstellen und p_code transformieren*/  
kollo's avatar
kollo committed
474 475 476 477
  for(i=0; i<prglen;i++) {
    zeile=realloc(zeile,strlen(program[i])+1);
    buffer=realloc(buffer,strlen(program[i])+1);
    strcpy(zeile, program[i]);
kollo's avatar
kollo committed
478
    
kollo's avatar
kollo committed
479
/*löschen nicht nötig, da das init_pcode macht.*/
kollo's avatar
kollo committed
480
//    code[i].opcode=0;       /*Typ und Kommandonummer*/
kollo's avatar
kollo committed
481 482
//    pcode[i].panzahl=0;       /*Anzahl Parameter*/
//    pcode[i].ppointer=NULL;   /*Zeiger auf Parameterliste*/
kollo's avatar
kollo committed
483
//    pcode[i].argument=NULL; /*String als argument*/
kollo's avatar
kollo committed
484
//    pcode[i].etyp=PE_NONE;   /* fuer Kommentare */
kollo's avatar
kollo committed
485
//    pcode[i].extra=NULL;   /*Extra string fuer Kommentare*/
kollo's avatar
kollo committed
486
    pcode[i].integer=-1;
kollo's avatar
kollo committed
487

kollo's avatar
kollo committed
488 489
    /* Seitenkommentar behandeln:*/

kollo's avatar
kollo committed
490
    wort_sep2(zeile," !",TRUE,zeile,buffer);  /*Kommentare abseparieren*/
kollo's avatar
kollo committed
491
    xtrim2(zeile,TRUE,zeile);
kollo's avatar
kollo committed
492 493
    if(strlen(buffer)) {
      pcode[i].etyp=PE_COMMENT;
kollo's avatar
kollo committed
494
      pcode[i].extra=strdup(buffer);
kollo's avatar
kollo committed
495
    }
kollo's avatar
kollo committed
496
    
kollo's avatar
kollo committed
497 498
#if defined DEBUG 
    printf("Zeile %d (%d) : %s\n",i,original_line(i),zeile);
kollo's avatar
kollo committed
499
#endif
kollo's avatar
kollo committed
500 501 502 503 504 505 506 507
    if(wort_sep(zeile,' ',TRUE,zeile,buffer)==0) {
      pcode[i].opcode=P_NOTHING;
      continue;
    }
    switch(*zeile) {
    case '\'':
    case '#':
    case '!':
kollo's avatar
kollo committed
508
      pcode[i].opcode=P_REM;
kollo's avatar
kollo committed
509
      pcode[i].argument=strdup(buffer);
kollo's avatar
kollo committed
510 511
      continue;
    case '@':
kollo's avatar
kollo committed
512
      pcode[i].argument=strdup(zeile+1);
kollo's avatar
kollo committed
513 514 515 516
      pcode[i].opcode=P_GOSUB|find_comm("GOSUB");
      continue;
    case '~':
      pcode[i].argument=strdup(zeile+1);
kollo's avatar
kollo committed
517
      pcode[i].opcode=P_VOID|find_comm("VOID");
kollo's avatar
kollo committed
518 519 520 521 522
      continue;
    }
    len=strlen(zeile);
    if(zeile[len-1]==':') {
      zeile[len-1]=0;
kollo's avatar
kollo committed
523
#ifdef DEBUG 
kollo's avatar
kollo committed
524
      printf("Label gefunden: %s in Zeile %d (%d)\n",zeile,i,original_line(i));
kollo's avatar
kollo committed
525 526
#endif
      pcode[i].opcode=P_LABEL;
kollo's avatar
kollo committed
527
      pcode[i].integer=add_label(zeile,i,(databufferlen?(databufferlen+1):databufferlen));
kollo's avatar
kollo committed
528 529 530
      continue;
    } 
    if(strcmp(zeile,"DATA")==0) {
kollo's avatar
kollo committed
531
      pcode[i].opcode=P_DATA;
kollo's avatar
kollo committed
532
#ifdef DEBUG
kollo's avatar
kollo committed
533
      printf("DATA Statement found in line %d (%d). <%s>\n",i,original_line(i),buffer);
kollo's avatar
kollo committed
534 535 536 537 538 539 540 541 542
#endif
      databuffer=realloc(databuffer,databufferlen+strlen(buffer)+2);
      if(databufferlen) databuffer[databufferlen++]=',';
      
      memcpy(databuffer+databufferlen,buffer,strlen(buffer));
      databufferlen+=strlen(buffer);
      databuffer[databufferlen]=0;
   //   printf("databuffer now contains %d Bytes.\n",databufferlen);
   //   printf("databuffer=<%s>\n",databuffer);
kollo's avatar
kollo committed
543 544 545
      continue;
    }
    typ=(PROC_PROC*(strcmp(zeile,"PROCEDURE")==0) | 
kollo's avatar
kollo committed
546
                   (PROC_FUNC*(strcmp(zeile,"FUNCTION")==0)) |
kollo's avatar
kollo committed
547 548
		   (PROC_DEFFN*(strcmp(zeile,"DEFFN")==0)));
    if(typ!=0) {
kollo's avatar
kollo committed
549
#ifdef DEBUG
kollo's avatar
kollo committed
550
      printf("procedure or function found in line %d (%d). Typ=%d, <%s>\n",i,original_line(i),typ,buffer);
kollo's avatar
kollo committed
551
#endif
kollo's avatar
kollo committed
552
      if(typ==PROC_DEFFN) {
kollo's avatar
kollo committed
553
        pcode[i].opcode=P_DEFFN;
kollo's avatar
kollo committed
554 555
        expr=searchchr2(buffer,'=');
	if(expr==NULL) {
kollo's avatar
kollo committed
556
	  printf("WARNING at line %d: ==> Syntax error: DEFFN\n",original_line(i));
kollo's avatar
kollo committed
557
	  pcode[i].argument=NULL;
kollo's avatar
kollo committed
558
	  pcode[i].opcode|=P_INVALID;
kollo's avatar
kollo committed
559 560 561 562 563 564 565
	} else {
	  *expr++=0;
	  pcode[i].argument=strdup(expr);
        }
      } else pcode[i].opcode=P_PROC;
      pos2=searchchr(buffer,'(');
      if(pos2 != NULL) {
kollo's avatar
kollo committed
566 567
          pos2[0]=0;pos2++;
          pos3=pos2+strlen(pos2)-1;
kollo's avatar
kollo committed
568
          if(pos3[0]!=')') printf("WARNING at line %d: ==> Syntax error: parameter list\n",original_line(i));
kollo's avatar
kollo committed
569 570 571
          else *pos3++=0;
      } else pos2=zeile+strlen(zeile);
      pcode[i].integer=add_proc(buffer,pos2,i,typ);
kollo's avatar
kollo committed
572 573 574 575 576
      continue;
    } 
    /* Rest Transformieren    */
    j=-1;
    if(strcmp(zeile,"ON")==0) {
kollo's avatar
kollo committed
577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602
       // TODO: Sonderbehandlung ON  
        char *w1,*w2,w3[strlen(buffer)+1],w4[strlen(buffer)+1];
	wort_sep_destroy(buffer,' ',TRUE,&w1,&w2);
	wort_sep(w2,' ',TRUE,w3,w4);
	// printf("Onspecial: <%s> <%s> --<%s>-- / <%s>\n",w1,w2,w3,w4);
         if(strcmp(w1,"ERROR")==0 || strcmp(w1,"BREAK")==0 || strcmp(w1,"MENU")==0) {
	   if(strcmp(w3,"GOSUB")==0) {
	     j=find_comm("ON B/E/M GOSUB");
	     sprintf(buffer,"%s,%s",w1,w4);
	   } else if(strcmp(w3,"GOTO")==0) {
	     j=find_comm("ON B/E/M GOTO");
	     sprintf(buffer,"%s,%s",w1,w4);
	   } else {
	     j=find_comm("ON B/E/M OTHER");
  	     sprintf(buffer,"%s,%s",w1,w3);
	   }
	  // printf("j=%d, buffer=<%s>\n",j,buffer);
         } else if(strcmp(w3,"GOSUB")==0) {
	   j=find_comm("ON GOSUB");
	   strcat(buffer,",");
	   strcat(buffer,w4);
         } else if(strcmp(w3,"GOTO")==0) {
	   j=find_comm("ON GOTO");
	   strcat(buffer,",");
	   strcat(buffer,w4);
	 } else j=find_comm(zeile);
kollo's avatar
kollo committed
603
    } else j=find_comm(zeile);
kollo's avatar
kollo committed
604
            
kollo's avatar
kollo committed
605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632
    if(j==-1) { /* Kein Befehl passt... */
      char *buf=malloc(strlen(zeile)+strlen(buffer)+2);
      char *pos,*name;
      strcpy(buf,zeile);
      if(strlen(buffer)) {strcat(buf," ");strcat(buf,buffer);}
      //  printf("EVAL: %s\n",buf);
      if(*buf=='&' || *buf=='+' || *buf=='-' || *buf=='~' || *buf=='@' || isdigit(*buf) ) {
	pcode[i].opcode=P_EVAL|P_NOCMD;
	pcode[i].panzahl=0;
	pcode[i].ppointer=NULL;
	pcode[i].argument=buf;
	continue;
      } 
      pos=searchchr2(buf,'=');
      name=buf;
      if(pos!=NULL) {
        *pos++=0;
	pcode[i].opcode=P_ZUWEIS; /* opcode durch P_ZUWEIS ersetzen, */
	pcode[i].argument=strdup(pos);
	int typ=vartype(name);
	int typ2=pcode[i].atyp=type(pos);   /* Argument typ merken, damit spaeter der richtige parser ausgewählt wird.*/
	char *vname,*argument;
	int e=klammer_sep_destroy(buf,&vname,&argument);
	char *r=varrumpf(name);
	    /*  Jetzt Variable anlegen, wenn noch nicht definiert,
	    	       pcode[i].integer= ist varnummer,
	    */
	if(typ&ARRAYTYP) {
kollo's avatar
kollo committed
633
  	      pcode[i].panzahl=0;
kollo's avatar
kollo committed
634
	      pcode[i].ppointer=NULL;
kollo's avatar
kollo committed
635
	      pcode[i].integer=add_variable(r,ARRAYTYP,typ&(~ARRAYTYP),V_DYNAMIC,NULL);
kollo's avatar
kollo committed
636
	      if((pcode[i].atyp&ARRAYTYP)!=ARRAYTYP) printf("WARNING: type mismatch in assignment at line %d.\n",original_line(i));
637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653
	      if(*argument) {  /*Idicies sind da */
                /* Subarray-Zuweisung..., */
		
		/*  Erstmal muss das Argument in eine Indexliste verwandelt werden, die muss dann in 
		pcode abgelegt werden.
		*/
		pcode[i].panzahl=count_parameters(argument);   /* Anzahl indizes z"ahlen*/
                if(pcode[i].panzahl>0) { 
  		  pcode[i].ppointer=calloc(pcode[i].panzahl,sizeof(PARAMETER));
		  make_preparlist(pcode[i].ppointer,argument);
		  // dump_parameterlist(pcode[i].ppointer,pcode[i].panzahl);  
                }
		// xberror(9,zeile); /*not implemented*/
		/* Das einzige Problem ist hier, wie unterscheidet man nun die Subarray-Zuweisung
		von einer einfachen Zuweisung zum Array-Element? Es gibt keinen Typ-Parameter 
		for den lvalue im P_CODE. Ein hinweis kann höchstens pcode[i].atyp geben.*/
	      }
kollo's avatar
kollo committed
654 655 656
        } else {
	      if(pcode[i].atyp&ARRAYTYP) printf("WARNING: type mismatch in assignment at line %d.\n",original_line(i));
              if(e>1) {  /*Idicies sind da */
kollo's avatar
kollo committed
657
		pcode[i].integer=add_variable(r,ARRAYTYP,typ,V_DYNAMIC,NULL);
kollo's avatar
kollo committed
658
		pcode[i].panzahl=count_parameters(argument);   /* Anzahl indizes z"ahlen*/
kollo's avatar
kollo committed
659
		pcode[i].ppointer=calloc(pcode[i].panzahl,sizeof(PARAMETER));
kollo's avatar
kollo committed
660 661
                /*hier die Indizies in einzelne zu evaluierende Ausdruecke
		  separieren*/
kollo's avatar
kollo committed
662
		  // printf("makepreparelist: <%s>\n",argument);
kollo's avatar
kollo committed
663 664 665
		make_preparlist(pcode[i].ppointer,argument);
              } else {
  	        pcode[i].panzahl=0;
kollo's avatar
kollo committed
666
	        pcode[i].ppointer=NULL;
kollo's avatar
kollo committed
667
	        pcode[i].integer=add_variable(r,typ,0,V_DYNAMIC,NULL);
kollo's avatar
kollo committed
668
	      }
kollo's avatar
kollo committed
669 670
	      if((typ&TYPMASK)!=(typ2&TYPMASK) && ((typ&TYPMASK)==STRINGTYP || (typ2&TYPMASK)==STRINGTYP))
	        printf("WARNING: type mismatch in assignment at line %d.\n",original_line(i));
kollo's avatar
kollo committed
671
	}
kollo's avatar
kollo committed
672 673 674 675 676 677
	if(pcode[i].integer==-1) printf("ERROR at line %d: variable could not be created.\n",original_line(i));
	free(r);
	free(buf);
        /* Jetzt noch die rechte Seite behandeln....*/
        pcode[i].rvalue=calloc(1,sizeof(PARAMETER));
	// printf("Rechte Seite <%s> typ=%x\n",pcode[i].argument,pcode[i].atyp);
678 679
        make_parameter_stage2(pcode[i].argument,PL_CONSTGROUP|(pcode[i].atyp&BASETYPMASK),pcode[i].rvalue);
        // dump_parameterlist(pcode[i].rvalue,1);
kollo's avatar
kollo committed
680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729
	pcode[i].rvalue->panzahl=0;  /* Warum muss das noch initialisiert werden?*/
	continue;
      }
      printf("WARNING at line %d: Syntax error: %s\n",original_line(i),buf);
      pcode[i].opcode=P_INVALID|P_NOCMD;
      pcode[i].panzahl=0;
      pcode[i].ppointer=NULL;
      pcode[i].argument=buf;
      continue;    
    } 
      /* j hat nun die passende Befehlnummer */
    pcode[i].opcode=comms[j].opcode|j;
    xtrim(buffer,TRUE,buffer);
    pcode[i].argument=strdup(buffer);

    if(comms[j].opcode==P_DATA) {
      printf("WARNING at line %d: Something is wrong. Data should have been treated already.\n",original_line(i));
    } else if(comms[j].opcode==P_LOOP) {/*Zugehoeriges DO suchen */
      pcode[i].integer=suchep(i-1,-1,P_DO,P_LOOP,P_DO);
      if(pcode[i].integer==-1)  structure_warning(original_line(i),zeile); /*Programmstruktur fehlerhaft */
    } else if(comms[j].opcode==P_WEND) {/*Zugehoeriges WHILE suchen */
      pcode[i].integer=suchep(i-1,-1,P_WHILE,P_WEND,P_WHILE);
      if(pcode[i].integer==-1)  structure_warning(original_line(i),zeile); /*Programmstruktur fehlerhaft */
    } else if(comms[j].opcode==P_NEXT) {/*Zugehoeriges FOR suchen */
      pcode[i].integer=suchep(i-1,-1,P_FOR,P_NEXT,P_FOR);
      if(pcode[i].integer==-1)  structure_warning(original_line(i),zeile); /*Programmstruktur fehlerhaft */
    } else if(comms[j].opcode==P_UNTIL) {/*Zugehoeriges REPEAT suchen */
      pcode[i].integer=suchep(i-1,-1,P_REPEAT,P_UNTIL,P_REPEAT);
      if(pcode[i].integer==-1)  structure_warning(original_line(i),zeile); /*Programmstruktur fehlerhaft */
    } else if(comms[j].opcode==P_ELSE) {/*Pruefen ob es ELSE IF ist. */
      char w1[strlen(buffer)+1],w2[strlen(buffer)+1];
      wort_sep(buffer,' ',TRUE,w1,w2);
      if(strcmp(w1,"IF")==0) {
        pcode[i].opcode=P_ELSEIF|j;
	strcpy(pcode[i].argument,w2);
        int l=strlen(pcode[i].argument);
        if(l>4) {
    	  if(strcmp(pcode[i].argument+l-5," THEN")==0) {
       // printf("Unnutzes THEN gefunden:\n");
    	    pcode[i].argument[l-5]=0;
    	  }
        }
      }
    } else if(comms[j].opcode==P_IF) {/*Unn"otiges THEN entfernen*/
      int l=strlen(pcode[i].argument);
      if(l>4) {
    	if(strcmp(pcode[i].argument+l-5," THEN")==0) {
       // printf("Unnutzes THEN gefunden:\n");
    	  pcode[i].argument[l-5]=0;
    	}
kollo's avatar
kollo committed
730
      }
kollo's avatar
kollo committed
731 732 733 734 735 736 737 738 739 740 741 742 743 744
    } 
    /*Argumente und Argument-Listen vorbereiten*/
    if(comms[j].pmax==0 || (pcode[i].opcode&PM_TYP)==P_SIMPLE) {
      pcode[i].panzahl=0;
      pcode[i].ppointer=NULL;
    } else if((pcode[i].opcode&PM_TYP)==P_ARGUMENT) {
      pcode[i].panzahl=0;
      pcode[i].ppointer=NULL;
    } else if((pcode[i].opcode&PM_TYP)==P_PLISTE) {
      int ii;
      pcode[i].panzahl=ii=count_parameters(pcode[i].argument);
      if((comms[j].pmin>ii && comms[j].pmin!=-1) || (comms[j].pmax<ii && comms[j].pmax!=-1))  
     	     printf("WARNING at line %d: Wrong number of parameters: %s.\n",original_line(i),comms[j].name); /*Programmstruktur fehlerhaft */
      if(ii==0) pcode[i].ppointer=NULL;
kollo's avatar
kollo committed
745
    }
kollo's avatar
kollo committed
746 747
     	 /* Einige Befehle noch nachbearbeiten */
    if(strcmp(zeile,"EXIT")==0) { /*Pruefen ob es EXIT IF ist. */
748 749 750 751 752 753 754 755 756 757 758 759 760
      char *w1,*w2;
      wort_sep_destroy(buffer,' ',TRUE,&w1,&w2);
      if(strcmp(w1,"IF")==0) {
        pcode[i].opcode=P_EXITIF|j;
        strcpy(pcode[i].argument,w2);
      } else {
      /* 
        hier prüfen ob es innerhalb einer Schleife ist, dann P_BREAK
        wenn nicht, dann normal EXIT kommando ausführen lassen.
        Die Prüfung geht erst im pass 2, also hier nur vormerken.
        */
        pcode[i].opcode=P_EXIT|j;
      }
kollo's avatar
kollo committed
761 762
    } 
  }  /*  FOR */
kollo's avatar
kollo committed
763 764


kollo's avatar
kollo committed
765
#ifdef DEBUG 
kollo's avatar
kollo committed
766
  puts("PASS 2:");
kollo's avatar
kollo committed
767
#endif
kollo's avatar
kollo committed
768 769 770 771
  /* Pass 2, jetzt sind alle Labels und Proceduren bekannt. 
     Sprungmarken werden noch gesetzt, sowie zusaetzliche
     Variablen aus Pliste (CLR,LOCAL,DIM,INC,DEC) noch hinzugefuegt.
  */
kollo's avatar
kollo committed
772
  for(i=0; i<prglen;i++) {
kollo's avatar
kollo committed
773 774
    switch(pcode[i].opcode&PM_SPECIAL) {
    case P_ELSE: /* Suche Endif */
kollo's avatar
kollo committed
775
      pcode[i].integer=suchep(i+1,1,P_ENDIF,P_IF,P_ENDIF)+1;
kollo's avatar
kollo committed
776
      if(pcode[i].integer==0)  structure_warning(original_line(i),"ELSE"); /*Programmstruktur fehlerhaft */
kollo's avatar
kollo committed
777 778
      break;
    case P_ELSEIF: /* Suche Endif */
kollo's avatar
kollo committed
779
      pcode[i].integer=suchep(i+1,1,P_ENDIF,P_IF,P_ENDIF)+1;
kollo's avatar
kollo committed
780
      if(pcode[i].integer==0)  structure_warning(original_line(i),"ELSE IF"); /*Programmstruktur fehlerhaft */
kollo's avatar
kollo committed
781 782
      break;
    case P_IF: /* Suche Endif */
kollo's avatar
kollo committed
783
      pcode[i].integer=suchep(i+1,1,P_ENDIF,P_IF,P_ENDIF)+1;
kollo's avatar
kollo committed
784
      if(pcode[i].integer==0)  structure_warning(original_line(i),"IF"); /*Programmstruktur fehlerhaft */
kollo's avatar
kollo committed
785 786
      break;
    case P_WHILE: /* Suche WEND */
kollo's avatar
kollo committed
787
      pcode[i].integer=suchep(i+1,1,P_WEND,P_WHILE,P_WEND)+1;
kollo's avatar
kollo committed
788
      if(pcode[i].integer==0)  structure_warning(original_line(i),"WHILE"); /*Programmstruktur fehlerhaft */
kollo's avatar
kollo committed
789 790
      break;
    case P_FOR: /* Suche NEXT */
kollo's avatar
kollo committed
791
      pcode[i].integer=suchep(i+1,1,P_NEXT,P_FOR,P_NEXT)+1;
kollo's avatar
kollo committed
792
      if(pcode[i].integer==0)  structure_warning(original_line(i),"FOR"); /*Programmstruktur fehlerhaft */
kollo's avatar
kollo committed
793 794 795 796 797
      break;
    case P_SELECT:
    case P_CASE:
    case P_DEFAULT:
    case P_CONTINUE: {/* Suche CASE/DEFAULT/ENDSELECT */
kollo's avatar
kollo committed
798 799 800 801 802 803 804 805 806 807 808 809
      int p1=pcode[i].integer=suchep(i+1,1,P_ENDSELECT,P_SELECT,P_ENDSELECT);
      if(p1<0) {
        structure_warning(original_line(i),"SELECT/ENDSELECT"); /*Programmstruktur fehlerhaft */
      } else {
        int p2=pcode[i].integer=suchep(i+1,1,P_CASE,P_SELECT,P_ENDSELECT);
        int p3=pcode[i].integer=suchep(i+1,1,P_DEFAULT,P_SELECT,P_ENDSELECT);
	if(p2<0 || p2>p1) p2=p3;
	else if(p3<0 || p3>p1) ; 
	else p2=min(p2,p3);
	
	if(p2<0 || p2>p1) pcode[i].integer=p1+1;
	else pcode[i].integer=p2+1;
kollo's avatar
kollo committed
810
      }
kollo's avatar
kollo committed
811 812
      } break;
    case P_BREAK:
813
    case P_EXIT:
kollo's avatar
kollo committed
814
    case P_EXITIF: { /* Suche ende Schleife*/
815 816
      int j=sucheloopend(i+1);
      if(j<0) { 
817 818 819 820 821 822 823 824 825
        if((pcode[i].opcode&PM_SPECIAL)==P_EXIT) {
          /*EXIT ohne Parameter dann als normales Kommando aufrufen.*/
          pcode[i].opcode=P_PLISTE|(pcode[i].opcode&PM_COMMS);
          pcode[i].panzahl=0;
          pcode[i].ppointer=NULL;
        } else {
          structure_warning(original_line(i),"BREAK/EXIT IF"); /*Programmstruktur fehlerhaft */
          pcode[i].integer=-1;
        }
kollo's avatar
kollo committed
826
      } else {
827
        /* Ansonsten EXIT ohne Parameter wie BREAK behandeln */
828 829
        if((pcode[i].opcode&PM_SPECIAL)==P_EXIT) pcode[i].opcode=P_BREAK|(pcode[i].opcode&PM_COMMS); 
        if((pcode[j].opcode&PM_SPECIAL)==P_ENDSELECT) pcode[i].integer=j; /* wichtig fuer compiler !*/
kollo's avatar
kollo committed
830 831
        else pcode[i].integer=j+1;
      }
kollo's avatar
kollo committed
832 833 834
      } break;
    case P_GOSUB: /* Suche Procedure */
      if(*(pcode[i].argument)=='&') pcode[i].integer=-1;  // TODO
kollo's avatar
kollo committed
835 836 837 838 839 840
      else {
        char buf[strlen(pcode[i].argument)+1];
	char *pos,*pos2;
        strcpy(buf,pcode[i].argument);
        pos=searchchr(buf,'(');
        if(pos!=NULL) {
kollo's avatar
kollo committed
841
          *pos=0;pos++;
kollo's avatar
kollo committed
842
          pos2=pos+strlen(pos)-1;
kollo's avatar
kollo committed
843
          if(*pos2!=')') {
kollo's avatar
kollo committed
844 845
	    printf("ERROR at line %d: Syntax error: GOSUB parameter list\n",original_line(i));
	    structure_warning(original_line(i),"GOSUB"); /*Programmstruktur fehlerhaft */
kollo's avatar
kollo committed
846 847 848
          } else pos2[0]=0;
        } else pos=buf+strlen(buf);
        pcode[i].integer=procnr(buf,1);
kollo's avatar
kollo committed
849 850 851 852
	/* Hier jetzt stage2 parameterliste aus Argument machen. Dabei 
	muss berücksichtigt werden, welche zielvariablen in der Procedur die Werte aufnehmen
	sollen. */
	pcode[i].panzahl=count_parameters(pos);
853 854 855 856 857 858 859 860 861 862 863 864 865 866 867
        if(pcode[i].integer>=0) {  /* Es kann ja sein, dass die Procedure nicht definiert ist. */
          if(pcode[i].panzahl!=procs[pcode[i].integer].anzpar) {
	    xberror(56,pcode[i].argument); /* Falsche Anzahl Parameter */
	    structure_warning(original_line(i),"GOSUB"); /*Programmstruktur fehlerhaft */
            pcode[i].opcode=P_INVALID|P_NOCMD;
            pcode[i].panzahl=0;
	  }
          if(pcode[i].panzahl) {
            unsigned short ptypliste[pcode[i].panzahl];
	    get_ptypliste(pcode[i].integer,ptypliste,pcode[i].panzahl);
	    make_pliste2(procs[pcode[i].integer].anzpar,procs[pcode[i].integer].anzpar,
	        ptypliste,pos,&(pcode[i].ppointer),pcode[i].panzahl);
          }
        } else {
          /* Procedure nicht gefunden, aber vielleicht wird sie spaeter per merge hinzugefügt ....*/
kollo's avatar
kollo committed
868
        }
869
     }
kollo's avatar
kollo committed
870 871
      break;
    case P_GOTO: /* Suche Label */
kollo's avatar
kollo committed
872
    /*  printf("Goto-Nachbearbeitung, <%s> \n",pcode[i].argument); */
kollo's avatar
kollo committed
873 874 875 876 877
      /* Wenn indirect, dann EVAL */
      if(*(pcode[i].argument)=='&') {
        pcode[i].opcode&=PM_COMMS;
	pcode[i].opcode|=P_EVAL;
      } else {
kollo's avatar
kollo committed
878
        pcode[i].integer=labelzeile(pcode[i].argument);
kollo's avatar
kollo committed
879
        /* Wenn label nicht gefunden, dann */
880 881 882 883 884 885
      //  if(pcode[i].integer==-1)  {
      //  printf("ERROR at line %d: Label %s not found!\n",original_line(i),pcode[i].argument);
      //  structure_warning(original_line(i),"GOTO"); /*Programmstruktur fehlerhaft */
      //  pcode[i].opcode|=P_INVALID;
      //  }
      /*  Es kann ja sein, dass das label erst spaeter durch MERGE hinzugefuegt wird.*/
kollo's avatar
kollo committed
886
      }
kollo's avatar
kollo committed
887 888
      break;
    } /*  SWITCH */
kollo's avatar
kollo committed
889
    if((pcode[i].opcode&PM_TYP)==P_PLISTE) { /* Nachbearbeiten */
kollo's avatar
kollo committed
890
       int j=pcode[i].opcode&PM_COMMS;
kollo's avatar
kollo committed
891
     //  printf("OPS: %s   anz=%d\n",comms[j].name,pcode[i].panzahl);
kollo's avatar
kollo committed
892 893 894
       make_pliste2(comms[j].pmin,comms[j].pmax,
	(unsigned short *)comms[j].pliste,pcode[i].argument,&(pcode[i].ppointer),pcode[i].panzahl);
    } 
kollo's avatar
kollo committed
895
  }  /*  for */
kollo's avatar
kollo committed
896
  free(buffer);free(zeile);
kollo's avatar
kollo committed
897
  return(0);
kollo's avatar
kollo committed
898 899
}

kollo's avatar
kollo committed
900
static int add_label(char *name,int zeile,int dataptr) {
kollo's avatar
kollo committed
901 902 903 904 905 906 907
  labels[anzlabels].name=strdup(name);
  labels[anzlabels].zeile=zeile;
  labels[anzlabels].datapointer=dataptr;
  anzlabels++;
  return(anzlabels-1);
}

kollo's avatar
kollo committed
908
/*Raeume pcode struktor auf und gebe Speicherbereiche wieder frei.*/
kollo's avatar
kollo committed
909

kollo's avatar
kollo committed
910 911 912 913 914 915
void free_pcode(int l) {
  while(l>0) {
    l--;
    if(pcode[l].ppointer!=NULL) {
      free_pliste(pcode[l].panzahl,pcode[l].ppointer);
      pcode[l].ppointer=NULL;
kollo's avatar
kollo committed
916
    }
kollo's avatar
kollo committed
917 918 919 920 921
    if(pcode[l].rvalue!=NULL) {
      free_parameter(pcode[l].rvalue);
      free(pcode[l].rvalue);
      pcode[l].rvalue=NULL;
    }
kollo's avatar
kollo committed
922 923 924 925 926
    if(pcode[l].argument!=NULL) free(pcode[l].argument);
    if(pcode[l].extra!=NULL) free(pcode[l].extra);
    pcode[l].argument=NULL;
    pcode[l].extra=NULL;
    pcode[l].panzahl=0;
kollo's avatar
kollo committed
927
  }
kollo's avatar
kollo committed
928 929
  if(pcode) free(pcode);
  pcode=NULL;
kollo's avatar
kollo committed
930
}
kollo's avatar
kollo committed
931 932


kollo's avatar
kollo committed
933
/*Bereitet die Variablenliste einer Procedur oder Funktion vor*/
kollo's avatar
kollo committed
934

kollo's avatar
kollo committed
935
static int make_varliste(char *argument, int *l,int n) {
kollo's avatar
kollo committed
936 937 938 939 940
  char arg[strlen(argument)+1];
  char *w1,*w2;
  int i=0,e;
  char *r;
  int typ,subtyp,vnr;
kollo's avatar
kollo committed
941
  int flag;
kollo's avatar
kollo committed
942 943 944
  strcpy(arg,argument);
  e=wort_sep_destroy(arg,',',TRUE,&w1,&w2);
  while(e && i<n) {
kollo's avatar
kollo committed
945 946 947 948
    if(w1[0]=='V' && w1[1]=='A' && w1[2]=='R' && w1[3]==' ') {
      w1+=4;
      flag=1;
    } else flag=0;
kollo's avatar
kollo committed
949 950 951 952 953 954 955
    r=varrumpf(w1);
    typ=vartype(w1);
    if(typ&ARRAYTYP) {
      subtyp=typ&(~ARRAYTYP);
      typ=ARRAYTYP;
    } else subtyp=0;
    
kollo's avatar
kollo committed
956
    l[i++]=vnr=(add_variable(r,typ,subtyp,V_DYNAMIC,NULL) | flag*V_BY_REFERENCE);
kollo's avatar
kollo committed
957 958 959 960 961 962
    free(r);
    e=wort_sep_destroy(w2,',',TRUE,&w1,&w2);
  }
  return(i);
}

kollo's avatar
kollo committed
963
/*Prozedur in Liste hinzufuegen */
kollo's avatar
kollo committed
964

kollo's avatar
kollo committed
965
static int add_proc(char *name,char *pars,int zeile,int typ) {
kollo's avatar
kollo committed
966 967 968 969 970
  int ap,i;
  i=procnr(name,typ);
  if(i==-1) {
    procs[anzprocs].name=strdup(name);
    procs[anzprocs].typ=typ;
kollo's avatar
kollo committed
971
    procs[anzprocs].rettyp=vartype(name);
kollo's avatar
kollo committed
972 973 974 975 976 977
    procs[anzprocs].zeile=zeile;
    procs[anzprocs].anzpar=ap=count_parameters(pars);
    if(ap) {
      procs[anzprocs].parameterliste=(int *)malloc(sizeof(int)*ap);
      make_varliste(pars,procs[anzprocs].parameterliste,ap);
    } else procs[anzprocs].parameterliste=NULL;
kollo's avatar
kollo committed
978
//printf("ADDPROC: name=%s rettyp=%x\n",procs[anzprocs].name,procs[anzprocs].rettyp);
kollo's avatar
kollo committed
979 980 981
    anzprocs++;
    return(anzprocs-1);
  } else {
kollo's avatar
kollo committed
982
    printf("ERROR: Procedure/Function %s already exists at line %d.\n",name,original_line(procs[i].zeile));
kollo's avatar
kollo committed
983
    return(i);
kollo's avatar
kollo committed
984 985 986 987
  }
}


kollo's avatar
kollo committed
988
char *indirekt2(const char *funktion) {
kollo's avatar
kollo committed
989 990
  if(funktion && *funktion=='&') {
    char *ergebnis=s_parser(funktion+1);
kollo's avatar
kollo committed
991
    xtrim(ergebnis,TRUE,ergebnis);
kollo's avatar
kollo committed
992 993
    return(ergebnis);
  } else return(strdup(funktion));
kollo's avatar
kollo committed
994 995
}

kollo's avatar
kollo committed
996

kollo's avatar
kollo committed
997 998


kollo's avatar
kollo committed
999

kollo's avatar
kollo committed
1000

kollo's avatar
kollo committed
1001 1002 1003 1004 1005





kollo's avatar
kollo committed
1006 1007 1008 1009
#if 0
/*Sucht anhand der Programmtextzeilen
  (anstelle von PCODE)
  obsolet */
kollo's avatar
kollo committed
1010
static int suche(int begin, int richtung, char *such,char *w1,char *w2) {
kollo's avatar
kollo committed
1011
  int i,f=0;
kollo's avatar
kollo committed
1012 1013 1014 1015 1016
  char nbuffer[MAXSTRLEN];
  char zbuffer[MAXSTRLEN];
  char sbuffer[MAXSTRLEN];
  char *zeile,*buffer,*b1,*b2;
  
kollo's avatar
kollo committed
1017
  for(i=begin; (i<prglen && i>=0);i+=richtung) {
kollo's avatar
kollo committed
1018 1019 1020 1021 1022
    xtrim(program[i],TRUE,zbuffer);
    wort_sep_destroy(zbuffer,'!',TRUE,&zeile,&buffer);
    wort_sep_destroy(zeile,' ',TRUE,&b1,&b2);
    strcpy(sbuffer+1,such); sbuffer[0]='|';
    strcat(sbuffer,"|");
kollo's avatar
kollo committed
1023 1024 1025
    strcpy(nbuffer+1,b1); nbuffer[0]='|';
    strcat(nbuffer,"|");
    /*printf("SUCHE: %d <%s> <%s> %d\n",i,buffer,nbuffer,f);*/
kollo's avatar
kollo committed
1026
    if(strstr(sbuffer,nbuffer)!=NULL && f==0) return(i);
kollo's avatar
kollo committed
1027 1028 1029 1030 1031
    else if(strcmp(b1,w1)==0) f++;
    else if(strcmp(b1,w2)==0) f--;
  }
  return(-1);
}
kollo's avatar
kollo committed
1032
#endif
kollo's avatar
kollo committed
1033 1034


kollo's avatar
kollo committed
1035
/*  Kommando in Direktmodus auswerten (ohne Strukturhilfe vom PASS 1+2).*/
kollo's avatar
kollo committed
1036
void kommando(char *cmd) {
kollo's avatar
kollo committed
1037
  char buffer[strlen(cmd)+1];
kollo's avatar
kollo committed
1038
  char *w1,*w2,*pos;
kollo's avatar
kollo committed
1039
  char zeile[strlen(cmd)+1];
kollo's avatar
kollo committed
1040
  int i,a,b,e,l;
kollo's avatar
kollo committed
1041 1042
  wort_sep2(cmd," !",TRUE,zeile,buffer);
  xtrim2(zeile,TRUE,zeile);
kollo's avatar
kollo committed
1043 1044 1045
// printf("KOMMANDO: <%s>\n",zeile);

/*  1. Analysiere erstes Zeichen der Zeile*/
kollo's avatar
kollo committed
1046 1047

  switch(*zeile) {
kollo's avatar
kollo committed
1048
  case 0:
kollo's avatar
kollo committed
1049
  case '\'':
kollo's avatar
kollo committed
1050
  case '#':
kollo's avatar
kollo committed
1051
  case '!':
kollo's avatar
kollo committed
1052
    return;  /* Kommentar oder leerzeile */
kollo's avatar
kollo committed
1053
  case '@':
kollo's avatar
kollo committed
1054
    c_gosub(zeile+1);
kollo's avatar
kollo committed
1055
    return;
kollo's avatar
kollo committed
1056
  case '~':
kollo's avatar
kollo committed
1057
    c_void(zeile+1);
kollo's avatar
kollo committed
1058 1059 1060
    return;
  case '&':
    {
kollo's avatar
kollo committed
1061 1062
      char *test=s_parser(zeile+1);
      kommando(test);
kollo's avatar
kollo committed
1063 1064 1065 1066 1067
      free(test);
    }
    return;
  case '(':
  case '-':
kollo's avatar
kollo committed
1068
  case '+':
kollo's avatar
kollo committed
1069
     printf("%.13g\n",parser(zeile));
kollo's avatar
kollo committed
1070 1071
     return;
  }
kollo's avatar
kollo committed
1072 1073 1074 1075
  if(isdigit(*zeile)) {
     printf("%.13g\n",parser(zeile));
     return;
  }
kollo's avatar
kollo committed
1076
  
kollo's avatar
kollo committed
1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091
  
  /* 2. Betrachte erstes Wort*/
  
  e=wort_sep_destroy(zeile,' ',TRUE,&w1,&w2);
  l=strlen(w1);
  if(w1[l-1]==':')             return;  /* nixtun, label */
  if(w1[l-1]=='=') {
    w1[l-1]=0;
    xzuweis(w1,w2);
    return;
  }
  if(*w2=='=') {
    xzuweis(w1,++w2);
    return;
  }
kollo's avatar
kollo committed
1092

kollo's avatar
kollo committed
1093 1094 1095 1096
  if((pos=searchchr2(w1,'='))!=NULL) {
    *pos++=0;
    if(e==2) w1[l]=' ';
    xzuweis(w1,pos);
kollo's avatar
kollo committed
1097
    return;
kollo's avatar
kollo committed
1098
  }
kollo's avatar
kollo committed
1099

kollo's avatar
kollo committed
1100 1101 1102
/*  Die PM_FLAGS sind hier irrelevant, also kein P_PREFETCH oder 
    P_INVALID.*/
  
kollo's avatar
kollo committed
1103

kollo's avatar
kollo committed
1104
  /* Restliche Befehle */
kollo's avatar
kollo committed
1105 1106
  i=find_comm_guess(w1,&a,&b);
  if(i!=-1) {
kollo's avatar
kollo committed
1107 1108 1109 1110 1111
    switch(comms[i].opcode&PM_TYP) {
      case P_IGNORE: xberror(38,w1); /* Befehl im Direktmodus nicht moeglich */return; 
      case P_ARGUMENT: (comms[i].routine)(w2); return;
      case P_SIMPLE: (comms[i].routine)(); return;
      case P_PLISTE: {
kollo's avatar
kollo committed
1112
        PARAMETER *plist;
kollo's avatar
kollo committed
1113
        int e=make_pliste(comms[i].pmin,comms[i].pmax,(unsigned short *)comms[i].pliste,w2,&plist);
kollo's avatar
kollo committed
1114
        if(e>=comms[i].pmin) (comms[i].routine)(plist,e);
1115
	free_pliste(e,plist);
kollo's avatar
kollo committed
1116 1117 1118 1119 1120 1121 1122
	}
	return;
      default: xberror(38,w1); /* Befehl im Direktmodus nicht moeglich */
    }
  } else if(a!=b) {
     printf("Command needs to be more specific ! <%s...%s>\n",comms[a].name,comms[b].name);
  } else xberror(32,w1);  /* Syntax Error */
kollo's avatar
kollo committed
1123 1124 1125
}


kollo's avatar
kollo committed
1126 1127 1128 1129


/* programmlauf setzt voraus, dass die Strukturen durch init_program vorbereitet sind*/

kollo's avatar
kollo committed
1130
void programmlauf(){
kollo's avatar
kollo committed
1131 1132 1133 1134 1135 1136 1137 1138 1139
  if(is_bytecode) {  
    PARAMETER *p;
    int n;
  #if DEBUG
    printf("Virtual Machine: %d bytes.\n",programbufferlen);
  #endif
    STRING bcpc;  /* Bytecode holder */
    bcpc.pointer=programbuffer;
    bcpc.len=programbufferlen;
kollo's avatar
kollo committed
1140
    p=virtual_machine(bcpc,0,&n,NULL,0);
kollo's avatar
kollo committed
1141 1142 1143 1144
    dump_parameterlist(p,n);  
    free_pliste(n,p);
    return;
  }
kollo's avatar
kollo committed
1145 1146
  int opc;
  int isp=sp;
kollo's avatar
kollo committed
1147
#ifdef DEBUG
kollo's avatar
kollo committed
1148
  int timer;
kollo's avatar
kollo committed
1149
#endif
kollo's avatar
kollo committed
1150 1151 1152 1153 1154 1155 1156 1157
  while(batch && pc<prglen && pc>=0 && sp>=isp)  {
    if(echoflag) printf("%s\n",program[pc]);
#ifdef DEBUG
    timer=clock();
#endif
    opc=pc;
      
    // printf("OPCODE=$%x/$%x $%x",pcode[opc].opcode,P_DEFFN,P_PROC);
kollo's avatar
kollo committed
1158
      
kollo's avatar
kollo committed
1159 1160 1161 1162 1163 1164 1165 1166
    /*  Erst flags auswerten: */
    
    /*  Prefetch kommt meist zusammen mit P_IGNORE vor, wenn es mit 
    P_ARGUMENT (z.B. bei GOTO) vorkommt, kann abgekürzt werden. Wenn es mit P_SIMPLE
    vorkommt (bei P_CONTINUE), kann auch abgekürzt werden, wenn nicht im direktmodus. */
    
    if((pcode[opc].opcode&P_PREFETCH)==P_PREFETCH) {
      pc=pcode[opc].integer;
1167 1168 1169 1170
      if(pc<0) {
        pc=opc+1;
        xberror(20,pcode[opc].argument); /* Label not found*/
      }
kollo's avatar
kollo committed
1171 1172
      continue;
    } else pc++;
kollo's avatar
kollo committed
1173
      
kollo's avatar
kollo committed
1174 1175
    if((pcode[opc].opcode&P_INVALID)==P_INVALID)  {xberror(32,program[opc]); /* Syntax error */break;}
    // printf("programmlauf: %x\n",pcode[opc].opcode);
kollo's avatar
kollo committed
1176
      
kollo's avatar
kollo committed
1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187
    /*  Jetzt Spezialanweisungen, zuerst die mit P_NOCMD */
    switch(pcode[opc].opcode) {
    case P_ZUWEIS: {
      int vnr=pcode[opc].integer;
      int typ=variablen[vnr].typ;
      int ii=pcode[opc].panzahl;
      // printf("ZUWEIS: <%s> --> %s\n",pcode[opc].argument,variablen[vnr].name);
      if(ii) {   /* Mit Index ....*/
        if(typ==ARRAYTYP) {
	  int dim=variablen[vnr].pointer.a->dimension;
	  if(ii!=dim) xberror(18,"");  /* Falsche Anzahl Indizies */
1188 1189 1190
	  int *indexliste=malloc(ii*sizeof(int));
	  get_indexliste(pcode[opc].ppointer,indexliste,ii);
	  PARAMETER *par=calloc(1,sizeof(PARAMETER));
kollo's avatar
kollo committed
1191
	  if(pcode[opc].rvalue) {
1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204
	    /* Das kann jetzt entweder eine Zuweisung zum Array-Element sein oder
	       Zuweisung eines Subarrays.*/
	    if((pcode[opc].atyp&ARRAYTYP)==ARRAYTYP) {
  	      make_parameter_stage3(pcode[opc].rvalue,PL_ARRAY,par);
	      feed_subarray_and_free(vnr,indexliste,ii,(ARRAY *)&(par->integer));
	      free_parameter(par);   
	    } else { /* Einfaches Element wird zugewiesen.*/
  	      make_parameter_stage3(pcode[opc].rvalue,(PL_CONSTGROUP|variablen[vnr].pointer.a->typ),par);
              zuweispbyindex(vnr,indexliste,ii,par);
	      free_parameter(par);
	    }
	  } else printf("Something is wrong: //zuweisxbyindex");
	  free(par);
kollo's avatar
kollo committed
1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217
	  free(indexliste);
        } else xberror(18,"");  /* Falsche Anzahl Indizies */
      } else {   /* Ohne indizies  ...*/
        if(pcode[opc].rvalue) {
	  PARAMETER *par=calloc(1,sizeof(PARAMETER));
	  int ap=variablen[vnr].typ;
	  if(ap==ARRAYTYP) ap|=variablen[vnr].pointer.a->typ;
  	  make_parameter_stage3(pcode[opc].rvalue,(PL_CONSTGROUP|ap),par);
          zuweis_v_parameter(&variablen[vnr],par);
	  free_parameter(par);free(par);
	} else {
	  printf("Something is wrong: //zuweisxbyindex");
	//  zuweisxbyindex(vnr,NULL,0,pcode[opc].argument,pcode[opc].atyp);
kollo's avatar
kollo committed
1218
	}
kollo's avatar
kollo committed
1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230
      }	  
    }
    case P_LABEL:
    case P_NOTHING: break;
    case (P_EVAL|P_NOCMD):  kommando(program[opc]); break;
    case P_PROC:
      xberror(36,program[opc]); /*Programmstruktur fehlerhaft !*/
      printf("END missing?\n");
      break;
    default: 
      if((pcode[opc].opcode&PM_COMMS)>=anzcomms) {
	printf("ERROR: invalid command #%d/%d (%x)\n",(int)(pcode[opc].opcode&PM_COMMS),anzcomms,(int)pcode[opc].opcode);
kollo's avatar
kollo committed
1231
	xberror(36,program[opc]); /*Programmstruktur fehlerhaft !*/
kollo's avatar
kollo committed
1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246
	break;
      }
      /*Jetzt noch Sonderfälle abfangen: */
      switch(pcode[opc].opcode&PM_SPECIAL) {
      case P_GOSUB: {
	int procnr=pcode[opc].integer;
	if(procnr==-1)   xberror(19,pcode[opc].argument); /* Procedure nicht gefunden */
        else {
	  unsigned short ptypliste[pcode[opc].panzahl];
	  get_ptypliste(procnr,ptypliste,pcode[opc].panzahl);
	  
  	  PARAMETER *plist;
	  int e=make_pliste3(pcode[opc].panzahl,pcode[opc].panzahl,ptypliste,
             pcode[opc].ppointer,&plist,pcode[opc].panzahl);

1247 1248
	  if(e>=0) call_sub_with_parameterlist(pcode[opc].integer,plist,pcode[opc].panzahl);
          free_pliste(e,plist);
kollo's avatar
kollo committed
1249
        }
kollo's avatar
kollo committed
1250

kollo's avatar
kollo committed
1251
	} break;
kollo's avatar
kollo committed
1252 1253 1254
      case P_VOID:
        c_void(pcode[opc].argument);
        break;
kollo's avatar
kollo committed
1255 1256 1257 1258 1259 1260 1261 1262 1263 1264
      default:
        switch(pcode[opc].opcode&PM_TYP) {
        case P_EVAL:   kommando(program[opc]);
        case P_IGNORE: break;
        case P_SIMPLE: (comms[pcode[opc].opcode&PM_COMMS].routine)(NULL); break;
        case P_ARGUMENT: (comms[pcode[opc].opcode&PM_COMMS].routine)(pcode[opc].argument); break;
        case P_PLISTE: {
          /*Hier ist ja schon das meiste vorbereitet !*/
          PARAMETER *plist;
          int i=pcode[opc].opcode&PM_COMMS;
kollo's avatar
kollo committed
1265
          int e=make_pliste3(comms[i].pmin,comms[i].pmax,(unsigned short *)comms[i].pliste,
kollo's avatar
kollo committed
1266
             pcode[opc].ppointer,&plist,pcode[opc].panzahl);
1267 1268
          if(e>=0) (comms[i].routine)(plist,e);
          free_pliste(e,plist);
kollo's avatar
kollo committed
1269 1270 1271 1272
        } break;
        default:
	    printf("something is wrong: %x %s\n",(int)pcode[opc].opcode,program[opc]);
        }
kollo's avatar
kollo committed
1273
      }
kollo's avatar
kollo committed
1274
    }
kollo's avatar
kollo committed
1275
#ifdef DEBUG
kollo's avatar
kollo committed
1276
    ptimes[opc]=(int)((clock()-timer)/1000);  /* evaluiert die Ausfuehrungszeit der Programmzeile */
kollo's avatar
kollo committed
1277
#endif
kollo's avatar
kollo committed
1278
  }
kollo's avatar
kollo committed
1279
}
kollo's avatar
kollo committed
1280 1281 1282 1283 1284 1285 1286 1287 1288 1289

/* Programm beenden und Aufr"aumen. */


void quit_x11basic(int c) {
#ifdef ANDROID
  invalidate_screen();
  sleep(1);
#endif
#ifndef NOGRAPHICS
kollo's avatar
kollo committed
1290
  close_window(&window[usewindow]); 
kollo's avatar
kollo committed
1291 1292 1293 1294 1295 1296 1297 1298
#endif
  /* Aufr"aumen */
  clear_program();
  free_pcode(prglen);
  if(programbuffer) free(programbuffer);
 // if(program) free(program); machen wir nicht, gibt aerger beim xbc - compiler
#ifdef CONTROL
  cs_exit();
kollo's avatar
kollo committed
1299 1300 1301 1302
#endif
#ifdef USE_GEM
// APPL_EXIT
// close VDI workstation
kollo's avatar
kollo committed
1303 1304 1305
#endif
  exit(c); 
}