/***   repr.c   ***/

#include "Algol.h"
   /***  ERRORS: 111,121,122,131,624,625,673 ***/

static void dismiss(int);
static void adjust_pointers(int);
static int copy_mode(int);
static void supersede_from_source(int);
/*----------------------------------------------------------------------*/
#define EQOPTOR		(040000 | 66)	/* see constants.h */

bool inp(s)  int s;
{
	if(X[P]==s || (s==EQ && X[P]==EQOPTOR)){P++;return(TRUE);}
	return(FALSE);
}

/**  spy(s)  (X[P]==s) **/

bool spy_declarer()
{int Pold,next;
	Pold=P;if(inp(OPEN))P=match();next=X[P];P=Pold;
	return(declarative_symbol(next) | ((next&060000)==040000));
}

bool inp_tag(t)  int *t;
{	if((X[P]& 060000)==020000){*t = X[P]&017777; P++; return(TRUE);}
	return(FALSE);
}

bool inp_ind(t) int *t;
{	if((X[P]& 060000)==040000){*t = X[P]&017777; P++; return(TRUE);}
	return(FALSE);
}

bool inp_denoter(t) int *t;
{	if((X[P]& 060000)==060000){*t = X[P]&017777; P++; return(TRUE);}
	return(FALSE);
}

int match()
{int i=1;
	while(i>0) { i += spy(CLOSE)?-1:spy(OPEN)?1:0; P++;}
	return(P);
}

/*----------------------------------------------------------------------*/
#define PART	077777	/* the biggest possible number, used in LIND[] */

void adm_open(jold) int *jold;
{	*jold = JGLOB; LIND[JGLOB = ++J]=PART;
			  must(J<max_IND,112); VIND[J]=1; }

void adm_close(jold) int jold;
{	JGLOB=jold;
	while(LIND[J] != PART){relax(VIND[J]); J--;}
	J--;
}

void adm_parameter(jold) int *jold;
{	LIND[*jold=(++J)]=PART; must(J<max_IND,113); VIND[J]=1;}

void adm_routine(jold,rold) int *jold;int rold;
{int j;
	j = *jold; *jold=JGLOB; JGLOB=j; must(rold<j,673); /*scope error*/
	while(LIND[++rold] != PART);
	VIND[j]=1+j-rold;
}

/**  possess(el,v)  {LIND[++J]=(el);VIND[J]=(v);must(J<max_IND,111);} **/
/**  mask(x)		(x | 020000) **/
#define masked(x)	(x & 020000)

void unmask(jold) int jold;
{	while(jold < J) LIND[++jold] &= 017777;}

int scope()
{int jj,Lj,more;
	if(J>JGLOB && !masked(LIND[JGLOB+1])) return(JGLOB);
	jj=JGLOB; more=TRUE;
	while(jj>0 && more){
	    if((Lj=LIND[jj])==PART){ jj -= VIND[jj];}
	      else{ more=masked(Lj); --jj;}
	}
	while(jj>0 && LIND[jj]!=PART) --jj;
	return(jj);
}

bool search(el,k) int el; int *k;
{int jj;
	jj=J;
	while(jj>0 && el != LIND[jj])
	   { jj -= LIND[jj]==PART ? VIND[jj] : 1;}
	*k = jj; return(jj>0);
}

bool further_search(el,dyad,jj,op_prio) int el,*jj,*op_prio; bool dyad;
{int j, v, pr; bool bl;
	j= *jj-1; bl= dyad;
	while(j>0){
	    if(el==LIND[j]){
		if(A[v=VIND[j]]==OP &&
		     (((pr=C[v])<10)==dyad )){
			 if(bl || !dyad)*op_prio=pr;
			 break;
		}
		else if(bl && A[v]==PRIO){
		    bl=FALSE; *op_prio=B[v];
		}
	    }
	    j -= LIND[j]==PART?VIND[j]:1;
	}
	*jj = j; return(j>0);
}

/*----------------------------------------------------------------------*/

int ask()
{int v;
	v=FS; must(FS>0,121); FS=D[v]; A[v]=0; D[v]=1; return(v);
}

int askn(n) int n;
{int v,v0,v1,vn,i; bool more, garbage;
	v=v1=FS; v0 = -1; more=garbage = v > 0; i=1;
	while( more && i<n)
	  { if((vn=D[v])!=0) /* and this is >0 */
		{ if(vn==v+1){i++;}else{i=1;v1=vn;v0=v;}
		  v=vn;
		}
	    else if(garbage){
		  while(FS>0){i=FS; FS=D[i]; D[i] = -1;}
		  FS=0;
		  for(i=max_A;i>0;i--){if(D[i]<0){D[i]=FS;FS=i;}}
		  v=v1=FS; v0 = -1; garbage=FALSE; i=1;
		  }
	    else {more=FALSE;}
	  }
	must(more,122);
	if( v0== -1 ){FS=D[v];}else{D[v0]=D[v];}
	for(i=0;i<n;i++){D[v1+i]=1;A[v1+i]=0;}
	return(v1);
}


/**  free(v) { D[v]=FS; FS=v;} **/

void freen(v,n) int v,n;
{int i;
	for(i=v+n-1; i>=v; i--)free(i);
}

/**  copy(v,w) {A[w]=A[v]; B[w]=B[v]; C[w]=C[v];} **/

void copyn(v,w,n) int v,w,n;
{int i;
	for(i=0; i<n;i++)copy(v+i,w+i);
}

/*----------------------------------------------------------------------*/
double re1,im1,re2,im2;

typedef union { double e; struct { int i1,i2,i3,i4;} ii ;} eii;
#define ri1(x)	(*((eii*)&x)).ii.i1
#define ri2(x)	(*((eii*)&x)).ii.i2
#define ri3(x)	(*((eii*)&x)).ii.i3
#define ri4(x)	(*((eii*)&x)).ii.i4

#define real_part(x,v)	   {ri1(x)=C[v];\
		v=B[v];ri2(x)=A[v];ri3(x)=B[v];ri4(x)=C[v];}

void store_real(v,ee) int v; double ee;
{	C[v]=ri1(ee);
	v=B[v]; A[v]=ri2(ee); B[v]=ri3(ee); C[v]=ri4(ee);
}

void put_real(ee) double ee;
{	A[Z=ask()]=REAL; B[Z]=ask(); store_real(Z,ee);}

bool get_real(v) int v;
{	if(A[v]==INT){re1=get_int(v); return(TRUE);}
	if(A[v]==REAL){ real_part(re1,v); return(TRUE);}
	return(FALSE);
}

void put_complex(re,im) double re,im;
{int v;
	A[v=ask()]=STRUCT; B[v]=askn(2); C[v]=2;
	put_real(re); B[B[v]]=Z; C[B[v]]=re_tag;
	put_real(im); B[B[v]+1]=Z; C[B[v]+1]=im_tag; Z=v;
}

bool get_complex(v) int v;
{int bv,bbv;
	switch(A[v]){
	case INT:	re1=get_int(v); im1=0.0; return(TRUE);
	case REAL:	real_part(re1,v); im1=0.0; return(TRUE);
	case STRUCT:	if(C[v]==2 && C[bv=B[v]]==re_tag && C[bv+1]==im_tag
			   && A[B[bv]]==REAL && A[B[bv+1]]==REAL){
			   bbv=B[bv]; real_part(re1,bbv);
			   bbv=B[bv+1]; real_part(im1,bbv);
			   return(TRUE);}
	}
	return(FALSE);
}
			  
/**  void_result(x)	A[Z=ask()]=VOID; **/

void put_denoter(d) int d;
{int v,i,n;
	switch(d & 016000){
            case 000000: A[Z=ask()]=INT; d &= 01777; B[Z]=DN[d];
				C[Z]=DN[d+1]; return;
            case 002000: A[Z=ask()]=REAL; d &= 01777; C[Z]=DN[d];
				v=B[Z]=ask(); A[v]=DN[d+1]; B[v]=DN[d+2];
				C[v]=DN[d+3]; return;
	    case 004000: A[Z=ask()]=CHAR; B[Z]=DN[d & 01777]; return;
            case 010000: A[Z=ask()]=BITS; d &= 01777; B[Z]=DN[d];
				C[Z]=DN[d+1]; return;
	    case 006000: A[Z=askn(3)]=ROW; B[Z]=Z+1; C[Z]=0;
			  A[Z+1]=A[Z+2]=C[Z+2]=1;
			  n=C[Z+1]=B[Z+2]=DN[d=d & 01777];
			  if(n==0)D[B[Z+1]=char_mode]++;else{
			      v=B[Z+1]=askn(n);
			      for(i=0;i<n;i++){
				  A[v+i]=CHAR; B[v+i]=DN[d+i+1];}
			  }
			  return;
	}
}

/*----------------------------------------------------------------------*/

/**  more_instance(v)  (D[v])++ **/

void more_instance_call(v) int v;
{	(D[v])++; }

int new_reference(v) int v;
{int w;
	A[w=ask()]=REF; ++D[B[w]=v]; C[w]=1; return(w);
}

/**  new_instance(v)	 move(TRUE,v,ask()) **/

/**  actual_instance(v)  move(FALSE,v,ask()) **/

void relax(v) int v;
{
	if(v>0 && references(v)>0 && ((--D[v])&037777) == 0)
		{dismiss(v); free(v);}
}

static void dismiss(v) int v;
{int bv,cv,n,i;
	bv=B[v]; cv=C[v];
	switch(A[v]){
	  case REAL:	free(bv); return;
	  case REF:	relax(bv); return;
	  case OP:	cv= cv==10?1:2;
	  case PROC:	for(i=0;i<=cv;i++)relax(B[bv+i]);
			freen(bv,cv+1); return;
	  case STRUCT:
	  case COLL:	for(i=0;i<cv;i++)relax(B[bv+i]);
			freen(bv,cv); return;
	  case ROW:	spelling_row(bv,relax);
			if(C[bv] == 0)relax(B[bv]);
			freen(bv,A[bv]+1); return;
	  case UNION:	n=C[bv]; relax(cv);
			for(i=0;i<n;i++)relax(B[bv+i]);
			freen(bv,n); return;
	}
}

int unfold(v) int v;
{
	if(recursive(v))return(new_instance(v));
	else{
	    more_instance(v); return(v);
	}
}

/*----------------------------------------------------------------------*/
int    source,destination;
#define standard_mode	23
#define max_move	50

static int rec_mode=0; static int a,b;
static short int VMOVE[max_move], WMOVE[max_move];
#define make_move(v,w)		{VMOVE[rec_mode]=v;WMOVE[rec_mode]=w;\
				 must(rec_mode++<=max_move,131);}

void adjust_pointer(u,v) int u,v;
{ a=u; b=v; adjust_pointers(u); rec_mode=0;}

#define adjust(v)  {if(v==a){v=b;}else{adjust_pointers(v);}}

static void adjust_pointers(v) int v;
{int i,bv,cv;
	if(recursive(v)){
	    for(i=0;i<rec_mode;i++){if(v==VMOVE[i]) return;}
	    make_move(v,v);
	}
	bv=B[v]; cv=C[v]; switch(A[v]){
	    case REF:	 adjust(bv); return;
	    case STRUCT: for(i=0;i<cv;i++)adjust(B[i+bv]); return;
	    case ROW:	 adjust(B[bv]); return;
	    case UNION:	 for(i=0;i<C[bv];i++)adjust(B[i+bv]); return;
	    case PROC:	 for(i=0;i<cv+1;i++)adjust(B[i+bv]); return;
	}
	return;
}

static int copy_mode(v) int v;
{int i,w,w1,bv,cv;
	if(rec_mode && v!=VMOVE[0] && v>standard_mode){
	    for(i=0;i<rec_mode;i++){if(v==VMOVE[i]) return(WMOVE[i]);}
	    w=ask(); copy(v,w); bv=B[v];
	    if(recursive(v)){make_move(v,w); put_recursivity(w);}
	    switch(A[v]){
	     case REAL:	 w1=B[w]=ask(); copy(bv,w1); break;
	     case REF:	 if(bv>0)B[w]=copy_mode(bv); break;
	     case STRUCT:w1=B[w]=askn(cv=C[v]); copyn(bv,w1,cv);
			 for(i=0;i<cv;i++)B[w1+i]=copy_mode(B[bv+i]);
			 break;
	     case ROW:	 cv=A[bv]; w1=B[w]=askn(cv+1); copyn(bv,w1,cv+1);
			 C[w1]=0; B[w1]=copy_mode(B[bv]); break;
	     case UNION: cv=C[bv]; w1=B[w]=askn(cv); C[w1]=cv; C[w]=0;
			 for(i=0;i<cv;i++)B[w1+i]=copy_mode(B[bv+i]);
			 break;
	     case PROC:  cv=C[v]+1; w1=B[w]=askn(cv); copy(bv,w1);
			 for(i=0;i<cv;i++)B[w1+i]=copy_mode(B[bv+i]);
			 break;
	    }
	    return(w);
	}else{more_instance(v); return(v);}
}

int move(fml,v,w) bool fml; int v,w;  /* v -> w */
{int old_rec_mode,bv,cv,w1,bw,m,n,i; /* take care of recursive modes */
	old_rec_mode=rec_mode; bv=B[v]; cv=C[v]; copy(v,w);
	if(rec_mode==0 && recursive(v)){make_move(v,v);}
	switch(A[v]){
	  case REAL:	bw=B[w]=ask(); copy(bv,bw); break;
	  case REF:	if(bv>0)B[w]=copy_mode(bv); break;
	  case STRUCT:	w1 = B[w] =askn(cv); copyn(bv,w1,cv);
			for(i=0;i<cv;i++)B[w1+i]=move(fml,B[bv+i],ask());
			break;
	  case ROW:	n=A[bv]; w1=B[w]=askn(n+1); copyn(bv,w1,n+1);
			if(fml){move_row(w1); break;}
			m=C[bv+1]*((m=B[bv+1]-A[bv+1])<0?0:m+1);
			if((C[w1]=m)!=0){
			    bw=B[w1]=askn(m); cv=B[bv];
			    for(i=0;i<m;i++)move(fml,cv,bw+i);
			}else{B[w1]=copy_mode(B[bv]);}
			break;
	  case COLL:	w1 = B[w] =askn(cv);
			for(i=0;i<cv;i++)B[w1+i]=move(fml,B[bv+i],ask());
			break;
	  case UNION:	n=C[bv];w1=B[w]=askn(n); C[w1]=n;
			if(cv>0)C[w]=move(fml,cv,ask());
			for(i=0;i<n;i++)B[w1+i]=copy_mode(B[bv+i]);
			break;
	  case PROC:	n=cv+1; w1=B[w]=askn(n); copyn(bv,w1,n);
			for(i=0;i<n;i++)B[w1+i]=copy_mode(B[bv+i]);
			break;
	}
	rec_mode=old_rec_mode; return(w);
}

void replace(v,w) int v,w; /* v -> w*/
{	if(references(v)>1){D[v]--; v=new_instance(v);}
	if(A[v]==ROW)C[v]=C[w]; /* to save flexibility */
	dismiss(w); move(TRUE,v,w); dismiss(v); free(v);
}

static void supersede_from_source(where) int where;
{	supersede(source,where); source++;}

void supersede(v,w) int v,w;  /* v -> w */
{int bv,bw,dim,i;
	if(references(v)>1){D[v]--; v=new_instance(v);}
	switch(A[v]){
	    case STRUCT:
		dim=C[v]; bv=B[v]; bw=B[w];
		for(i=0;i<dim;i++)supersede(B[bv+i],B[bw+i]);
		freen(bv,dim); free(v); return;
	    case ROW:
		if(C[w]==1){ /* not flexibile */
		    bv=B[v]; bw=B[w]; dim=A[bv];
		    for(i=1;i<=dim;i++){must(A[bv+i]==A[bw+i],624);
			must(B[bv+i]==B[bw+i],625);
		    }
		    i=source; source=B[bv];
		    spelling_row(bw,supersede_from_source);
		    source=i; freen(bv,dim+1); free(v); return;
		}else{C[v]=0;}
	    default:
		dismiss(w); move(TRUE,v,w); dismiss(v); free(v);
	}
}

void move_to_destination(from) int from;
{	move(TRUE,from,destination); destination++;}

void move_row(v) int v;
{int vv,n,w,i;
	if((n=C[v])==0){B[v]=copy_mode(B[v]); return;}
	i=destination; w=destination=askn(n);
	spelling_row(v,move_to_destination);
	destination=i; vv=v+A[v]; B[v]=w; C[vv]=1;
	for(i=vv;i>v+1;i--)C[i-1]=(B[i]-A[i]+1)*C[i];
}

void spelling_row(v,p) int v; void (*p)(int);
{int offst,n,vv,index,i,j,k;
	if((n=C[v])==0)return; /* number of elements */
	vv=v+A[v];
	for(index=0;index<n;index++){
	    offst=B[v]; j=index;
	    for(i=vv;i>v;i--){
		offst += (j%(k=B[i]-A[i]+1))*C[i]; j /= k;
	    }
	    (*p)(offst);
	}
}