Commit 1f7e81ab authored by kollo's avatar kollo

implemented subarray asignment in interpreter & bytecode

parent 5b8cf67f
Guide to contributing to X11-Basic
==================================
Things left to do:
==================
- Optimize a bit more
- The WIndows-Version needs more work
X11-Basic exists for quite a while now. Therefore I consider
it to be in a quite mature state. I am planning not to extend the language much,
e.g. I do not want to add many more commands or functions. The language as it is
should stay much the same as it is now.
However, there are still some bugs and also some of the features mentioned in
the manual are not implemented. As there are
1. The Array operators a(1:2,3) with a specified range are not implemented.
Always a complete row must be used: a(:,3) works fine.
2. Modifyable lvalued, like MIDS(t$,2,3)=a$ are not implemented, also
TIME$="12:04:06" does not work as you might expect (resulting in setting the
systems time). However, an array with index range as a lvalue does already
work.
These issues should be fixed somewhen. Also there are Ideas for adding Bluetooth
support and USB support to the Android version of X11-Basic. This should lead
to as few additional commands and functions as possible. Maybe it can be done
usinge external binaries called via the shell (like the SQL support is
implemented).
Difficult bugs:
===============
There is a strange bug related to screen refresh in the Android version of
X11-Basic. Does anybody have an idea what could be the problem?
More things left to do:
=======================
- Optimize a bit more, improve performance
- The WINDOWS-Version needs more work
- Fix the bugs
- work on the sound system
- work on the SDL-Graphics implementation (fill styles etc...)
......
......@@ -12,3 +12,4 @@ Release notes for Version 1.24 (Sept 2015 -- )
- fixed bug in PUT (Android)
- added sqlite3 binary to Android Version (make sqldemo.bas work again)
- added gfalist binary to Android Version (see gfalist.bas)
- fixed subarry assignment
......@@ -1327,3 +1327,16 @@ ARRAY array_array_element(const ARRAY *a, int *idx) {
}
return(double_array(&varptr[anz]));
}
/*********** Subarray functions ****************/
/*bestimmt die dimension eines Subarrays anhand der indexliste*/
int subarraydimf(int *indexliste, int n) {
int dim=0;
if(indexliste) {
while(--n>=0) { if(indexliste[n]<0) dim++; }
}
return dim;
}
......@@ -61,6 +61,9 @@ void arbint_array_element (const ARRAY *a, int *idx, ARBINT ret);
double array_det(const ARRAY *a);
int subarraydimf(int *,int);
/* Kleinere Hilfsfunktionen als inline Makro*/
......
......@@ -1675,16 +1675,24 @@ void compile(int verbose) {
int ii=pcode[i].panzahl;
// int dim=variablen[vnr].pointer.a->dimension;
int typ=variablen[vnr].typ;
bc_parser(pcode[i].argument);
bc_parser(pcode[i].argument); /* Das Argument liegt nun aufm Stack*/
// printf("TL=%x ii=%d typ=%x\n",TL,ii,typ);
if((typ&TYPMASK)==INTTYP) {
if(TL!=PL_INT) {BCADD(BC_X2I);TR(PL_INT);}
} else if((typ&TYPMASK)==ARBINTTYP) {
if(TL!=PL_ARBINT) {BCADD(BC_X2AI);TR(PL_ARBINT);}
} else if((typ&TYPMASK)==FLOATTYP) {
if(TL==PL_INT) {BCADD(BC_I2F);TR(PL_FLOAT);}
else if(TL!=PL_FLOAT) {BCADD(BC_X2F);TR(PL_FLOAT);}
} else if((typ&TYPMASK)==COMPLEXTYP) {
if(TL!=PL_COMPLEX) {BCADD(BC_X2C);TR(PL_COMPLEX);}
} else if((typ&TYPMASK)==STRINGTYP) {
if(TL!=PL_STRING) printf("ERROR: cannot convert <%s> (Typ=%x) to string.\n",pcode[i].argument,TL);
}
if(ii) {
/* ARRAY braucht (hier) nicht konvertiert zu werden*/
if(ii) { /* Bei Array Element Zuweisung oder SUBARRAY Zuweisung*/
short ss=vnr;
short f=ii;
push_indexliste(pcode[i].ppointer,ii);
......
......@@ -405,10 +405,10 @@ int make_parameter_stage2(char *n,unsigned short ap, PARAMETER *pret) {
pret->arraytyp=typ; /* für spaeter */
*((STRING *)&(pret->integer))=create_string(n);
}
} else {
} else { /* nicht const typ*/
pret->typ=PL_EVAL;
*((STRING *)&(pret->integer))=create_string(n);
/* TODO: Hier koennte man noch den Typ in Parametere eintragen, dann hat man es zu laufzeit schneller*/
/* Typ in Parameter eintragen, dann hat man es zu laufzeit schneller*/
pret->arraytyp=typ; /* Muss man spaeter natuerlich noch auswerten....*/
}
break;
......@@ -668,8 +668,7 @@ int make_parameter_stage3(PARAMETER *pin,unsigned short ap,PARAMETER *pret) {
ARRAY arr;
if(pin->typ==PL_ARRAY) arr=double_array((ARRAY *)&(pin->integer));
else arr=array_parser(pin->pointer);
*((ARRAY *)&(pret->integer))=arr;
*((ARRAY *)&(pret->integer))=arr;
if(ap==PL_IARRAY && (arr.typ==FLOATTYP||arr.typ==COMPLEXTYP||arr.typ==ARBINTTYP)) {
*((ARRAY *)&(pret->integer))=convert_to_intarray(&arr);
free_array(&arr);
......@@ -693,6 +692,8 @@ int make_parameter_stage3(PARAMETER *pin,unsigned short ap,PARAMETER *pret) {
} else if(ap==PL_CFARRAY && (arr.typ==INTTYP||arr.typ==ARBINTTYP)) {
*((ARRAY *)&(pret->integer))=convert_to_floatarray(&arr);
free_array(&arr);
} else if(ap==PL_ARRAY) {
; /* nixtum*/
} else {
printf("line %d: Error: Parameter is wrong (typ=%x) ARRAY (need to be $%x). Cannot convert.\n",pc,ip,ap);
dump_parameterlist(pin,1);
......
......@@ -287,18 +287,18 @@ void set_var_adr(int vnr,void *adr) {
void zuweisxbyindex(int vnr,int *indexliste,int n,char *ausdruck,short atyp) {
int typ=variablen[vnr].typ;
char *varptr=varptr_indexliste(&variablen[vnr],indexliste,n);
int ia=0;
// printf("zuweisxbyindex: <%s> typ=%x n=%d\n",ausdruck,typ,n);
if(typ==ARRAYTYP) {
ia=isarray(indexliste,n);
// printf("ia=%d varptr=%p\n",ia,varptr);
if(ia==NO_ARRAY) typ=(variablen[vnr].pointer.a)->typ;
else if(ia==SUB_ARRAY) {
xberror(9,"Subarray"); /* Funktion noch nicht moeglich */
ARRAY arr=array_parser(ausdruck);
feed_subarray_and_free(vnr,indexliste,n,&arr);
return;
}
}
char *varptr=varptr_indexliste(&variablen[vnr],indexliste,n);
// printf("zuw: %s: %p ia=%d typ=$%x\n",variablen[vnr].name,varptr,ia,typ);
if(varptr) {
ARRAY arr,*zarr;
......@@ -525,14 +525,17 @@ void zuweispbyindex(int vnr,int *indexliste,int n,PARAMETER *p) {
char *varptr;
STRING str;
if(indexliste==NULL) n=0;
#if 0
else {
int i;
printf("INDEXE: ");
for(i=0;i<n;i++) printf("%d ",indexliste[i]);
printf("\n");
if(n) {
/* Erstmal rausfinden ob die Indexliste ein SUBARRAY markiert....*/
if(subarraydimf(indexliste,n)>0) {
if(typ==ARRAYTYP && p->typ==PL_ARRAY) {
ARRAY a=double_array((ARRAY *)&(p->integer));
feed_subarray_and_free(vnr,indexliste,n,&a);
return;
} else printf("Something is wrong!\n");
}
}
#endif
varptr=varptr_indexliste(&variablen[vnr],indexliste,n);
// printf("VARPTR--__>%p typ=%x\n",varptr,typ);
if(varptr) {
......@@ -696,88 +699,107 @@ int izuweis(const char *name, int wert) {
return(0);
}
/* ARRAY arr in ein anderes (ARRAY Variable) also Sub-Array einfügen....*/
#if 0
void feed_subarray_and_free(int vnr,char *pos, ARRAY wert) {
char w1[strlen(pos)+1],w2[strlen(pos)+1];
int e,rdim=0,ndim=0,anz=1,anz2=1,j,k;
int indexe[variablen[vnr].opcode];
int indexo[variablen[vnr].opcode];
int indexa[variablen[vnr].opcode];
/* Dimension des reduzierten Arrays bestimmen */
e=wort_sep(pos,',',TRUE,w1,w2);
while(e) {
indexa[ndim]=anz;
if(*w1!=':' && *w1!=0) {
indexo[ndim]=(int)parser(w1);
rdim++;
} else {
anz=anz*(((int *)variablen[vnr].pointer)[ndim]);
/* printf("dim(vnr)=%d, dim(wert)=%d\n",((int *)variablen[vnr].pointer)[ndim],((int *)wert->pointer)[rdim]);
do_gets("");*/
indexo[ndim]=-1;
}
ndim++;
e=wort_sep(w2,',',TRUE,w1,w2);
}
/* Dimensionierung uebertragen */
if(wert.dimension!=max(variablen[vnr].opcode-rdim,1)) xberror(74,variablen[vnr].name); /* Dimensioning mismatch */
for(j=0;j<anz;j++) { /*Loop fuer die Komprimierung */
int jj=j;
/* Indexliste aus anz machen */
for(k=variablen[vnr].opcode-1;k>=0;k--) {
if(indexo[k]==-1) {
indexe[k]=jj/indexa[k];
jj=jj % indexa[k];
} else indexe[k]=indexo[k];
}
/* Testen ob passt */
anz2=0;
for(k=0;k<variablen[vnr].opcode;k++)
anz2=anz2*((int *)variablen[vnr].pointer)[k]+indexe[k];
if(jj!=0) {
printf("INTERNAL ERROR: %d: Rechnung geht nicht auf. <%s>\n",jj,pos);
xberror(70,""); /* Unknown Error */
#ifdef DEBUG
printf("anz=%d\n",anz);
printf("--anz2=%d\n",anz2);
printf("ARRAY wert: dim=%d (",wert->dimension);
for(i=0;i<wert->dimension;i++) printf("%d ",((int *)wert->pointer)[i]);
puts(")");
printf("ARRAY vnr: dim=%d (",variablen[vnr].opcode);
for(i=0;i<variablen[vnr].opcode;i++) printf("%d ",((int *)variablen[vnr].pointer)[i]);
puts(")");
printf("INDEXO: [");
for(i=0;i<variablen[vnr].opcode;i++) printf("%d ",indexo[i]);
puts("]");
printf("INDEXE: [");
for(i=0;i<variablen[vnr].opcode;i++) printf("%d ",indexe[i]);
puts("]");
printf("INDEXA: [");
for(i=0;i<variablen[vnr].opcode;i++) printf("%d ",indexa[i]);
puts("]");
do_gets("Press RETURN");
#endif
}
/* jetzt kopieren */
((double *)(variablen[vnr].pointer+INTSIZE*variablen[vnr].opcode))[anz2]=((double *)(wert.pointer+INTSIZE*wert.dimension))[j];
}
void feed_subarray_and_free(int vnr,int *indexliste, int n, ARRAY *arr) {
int subdim=subarraydimf(indexliste,n);
int typ=variablen[vnr].typ;
// printf("feed_subarray_and_free\n");
if(typ==ARRAYTYP) {
ARRAY *zarr=variablen[vnr].pointer.a;
/* Zuerst dimension überprüfen...*/
if(arr->dimension!=subdim) xberror(74,"<subarray>"); /* Dimensioning mismatch */
else {
ARRAY tmparr;
/* Dann ggf ARRARY Typ anpassen */
if(zarr->typ==arr->typ) ; /* nix tun */
else if(zarr->typ==INTTYP) {
tmparr=convert_to_intarray(arr); free_array(arr); arr=&tmparr;
} else if(zarr->typ==ARBINTTYP) {
tmparr=convert_to_arbintarray(arr); free_array(arr); arr=&tmparr;
} else if(zarr->typ==COMPLEXTYP) {
tmparr=convert_to_complexarray(arr); free_array(arr); arr=&tmparr;
} else if(zarr->typ==FLOATTYP) {
tmparr=convert_to_floatarray(arr); free_array(arr); arr=&tmparr;
} else {
xberror(58,variablen[vnr].name); /* Variable %s has incorrect type*/
printf("dest-Typ: %x / %x \n",zarr->typ,arr->typ);
}
/* Jetzt haben beide Arrays den gleichen Typ */
int bindex[zarr->dimension];
int aindex[arr->dimension];
int *cdim=(int *)arr->pointer;
int *ddim=(int *)zarr->pointer;
int cc=0;
int anz=anz_eintraege(arr);
int jj=0;
int j,k,i;
int firsti=-1;
int adim=zarr->dimension;
/* Dimensionierungen überprüfen */
if(adim) {
for(i=0;i<adim;i++) {
if(indexliste[i]==-1) {
if(firsti==-1) firsti=i;
if(cdim[cc++]!=ddim[i]) xberror(74,"<subarray>"); /* Dimensioning mismatch */
}
}
}
for(j=0;j<anz;j++) {
jj=j;
for(k=zarr->dimension-1;k>=0;k--) {
if(indexliste[k]==-1) {
if(k!=firsti) {
bindex[k]=jj/cdim[k];
jj=jj % ddim[k];
} else {
bindex[k]=jj;
jj=0;
}
} else bindex[k]=indexliste[k];
}
// printf("(");
// for(i=0;i<zarr->dimension;i++) printf("%d,",bindex[i]);
// printf(") -- (");
jj=j;
for(k=arr->dimension-1;k>=0;k--) {
if(k!=0) {
aindex[k]=jj/cdim[k];
jj=jj % cdim[k];
} else {
aindex[k]=jj;
jj=0;
}
}
// for(i=0;i<arr->dimension;i++) printf("%d,",aindex[i]);
// printf(")\n");
/* Jetzt ein Element kopieren*/
char *varptr=varptr_indexliste(&variablen[vnr],bindex,n);
if(varptr) {
switch(zarr->typ) {
case INTTYP: *((int *)varptr)= int_array_element(arr,aindex); break;
case FLOATTYP: *((double *)varptr)= float_array_element(arr,aindex); break;
case COMPLEXTYP: *((COMPLEX *)varptr)=complex_array_element(arr,aindex); break;
case ARBINTTYP:
mpz_init(*((ARBINT *)varptr));
arbint_array_element(arr,aindex,*((ARBINT *)varptr));
break;
case STRINGTYP:
free_string((STRING *)varptr);
*((STRING *)varptr)= string_array_element(arr,aindex); break;
case ARRAYTYP:
free_array((ARRAY *)varptr);
*((ARRAY *)varptr)= array_array_element(arr,aindex); break;
default: xberror(13,variablen[vnr].name); /* Type mismatch */
}
}
}
}
} else printf("Something is wrong.\n");
free_array(arr);
}
#endif
/* Weist einer $-Variable eine Zeichenkette zu */
......
......@@ -74,7 +74,7 @@ void zuweispbyindex(int vnr,int *indexliste,int n,PARAMETER *p);
int zuweis(const char *name, double wert);
int izuweis(const char *name, int wert);
void zuweisxbyindex(int vnr,int *indexliste,int,char *ausdruck,short atyp);
void feed_subarray_and_free(int vnr,char *pos, ARRAY wert);
void feed_subarray_and_free(int vnr,int *,int, ARRAY *wert);
int zuweiss(char *name, char *inhalt);
int zuweissbuf(char *name, char *inhalt,int len);
int zuweis_string_and_free(const char *name, STRING inhalt);
......
......@@ -627,7 +627,23 @@ int init_program(int prglen) {
pcode[i].ppointer=NULL;
pcode[i].integer=add_variable(r,ARRAYTYP,typ&(~ARRAYTYP),V_DYNAMIC,NULL);
if((pcode[i].atyp&ARRAYTYP)!=ARRAYTYP) printf("WARNING: type mismatch in assignment at line %d.\n",original_line(i));
/*TODO: Subarray-Zuweisung...*/
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.*/
}
} 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 */
......@@ -652,8 +668,8 @@ int init_program(int prglen) {
/* 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);
make_parameter_stage2(pcode[i].argument,(PL_CONSTGROUP|(pcode[i].atyp&BASETYPMASK)),pcode[i].rvalue);
// dump_parameterlist(pcode[i].rvalue,1);
make_parameter_stage2(pcode[i].argument,PL_CONSTGROUP|(pcode[i].atyp&BASETYPMASK),pcode[i].rvalue);
// dump_parameterlist(pcode[i].rvalue,1);
pcode[i].rvalue->panzahl=0; /* Warum muss das noch initialisiert werden?*/
continue;
}
......@@ -1141,19 +1157,24 @@ void programmlauf(){
if(ii) { /* Mit Index ....*/
if(typ==ARRAYTYP) {
int dim=variablen[vnr].pointer.a->dimension;
int *indexliste=malloc(ii*sizeof(int));
get_indexliste(pcode[opc].ppointer,indexliste,ii);
if(ii!=dim) xberror(18,""); /* Falsche Anzahl Indizies */
int *indexliste=malloc(ii*sizeof(int));
get_indexliste(pcode[opc].ppointer,indexliste,ii);
PARAMETER *par=calloc(1,sizeof(PARAMETER));
if(pcode[opc].rvalue) {
PARAMETER *par=calloc(1,sizeof(PARAMETER));
make_parameter_stage3(pcode[opc].rvalue,(PL_CONSTGROUP|variablen[vnr].pointer.a->typ),par);
zuweispbyindex(vnr,indexliste,ii,par);
free_parameter(par);
free(par);
} else { /* Kann entfernt werden, da nicht mehr benötigt....*/
printf("Something is wrong: //zuweisxbyindex");
// zuweisxbyindex(vnr,indexliste,ii,pcode[opc].argument,pcode[opc].atyp);
}
/* 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);
free(indexliste);
} else xberror(18,""); /* Falsche Anzahl Indizies */
} else { /* Ohne indizies ...*/
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment