/***   standard.c   ***/

#include <math.h>
#ifndef __TURBOC__ /** standard prototypes **/
	long time(long);
	long random(void);
	void srandom(int);
#else
	#include <stdlib.h>
	#include <time.h>
#endif

#include "Algol.h"
#include "standard.h"
#include "coercion.h"
#include "transput.h"
#include "unit.h"
  /*** ERRORS: 711-4,721-2,731-2,741-2,751-3,814-5,821-3  ***/

/*-----------------------------------------------------------------------*/
/* prototypes */
static void bitspack(int);
static void math_func(int);
static void plusto_op(int,int);
static void ab_op(int,int,int);
static void bool_op(int,int,int);
static void cmp_op(int,int,int);
static void aritm_op(int,int,int);
static void updown_op(int,int,int);
static void plit_op(int,int);
static void bound_op(int,int,int);
static void get_string(int);
static void get_strings(int,int);
static void string_sum(void);
static void string_mult(inta);
static void copy_string(int,int,int,int);
static int compare_strings(void);
static bool get_reals(int,int);
static bool get_complexs(int,int);
static void complex_op(int);
/*-----------------------------------------------------------------------*/

void initialize_pi_and_random()
{int i;
	B[real_mode]=ask(); store_real(real_mode, 4*atan(1.0));
	randomize(); for(i=0;i<100;i++)rand();
}

void math_func(op) int op;
{	switch(op){
	    case sqrt_ST:	put_real(sqrt(re1)); return;
	    case exp_ST:	put_real(exp(re1)); return;
	    case log_ST:	put_real(log(re1)); return;
	    case cos_ST:	put_real(cos(re1)); return;
	    case arccos_ST:	put_real(acos(re1)); return;
	    case sin_ST:	put_real(sin(re1)); return;
	    case arcsin_ST:	put_real(asin(re1)); return;
	    case tan_ST:	put_real(sin(re1)/cos(re1)); return;
	    case arctan_ST:	put_real(atan(re1)); return;
	}
}

static void bitspack(w) int w;
{inta b=0; int offset,i,n;
	n=C[w]; offset=C[w+1]; w=B[w];
	for(i=0;i<n;i++){b=(b<<1)|B[w]; w+=offset;}
	put_bits(b);
}

void standard_proc(op,Q) int op,*Q;
{int el,w;
	if(op==random_ST){
	    put_real(rand()/((double)RAND_MAX)); return;}
	if(transput_ST(op)){
	    must(unit(Q),821); must(*Q==G,823); w=Z;
	    if(op==read_ST){general_input(Z);}else{general_output(Z);}
	    must(inp(CLOSE),822); relax(w); void_result(); return;
	}
	if(layout_ST(op)){
	    must(inp_tag(&el),814); must(inp(CLOSE),815); layout(el,op);
	    void_result(); return;
	}
	if(op==bitspack_ST){
	    must(unit(Q),751); must(inp(CLOSE),752);
	    must(strong_coercion(row_of_bool_mode,Q),753);
	    if(*Q==G){
		w=B[Z]; emp(); bitspack(w);
	    } return;
	}
	must(math_ST(op),714); must(unit(Q),711); must(inp(CLOSE),712);
	must(strong_coercion(real_mode,Q),713);
	if(*Q==G){get_real(Z); emp(); math_func(op);}
}

void standard_monadic(op,u) int op,u;
{inta i; int j;
	switch(A[u]){
	  case INT:	i=get_int(u); switch(op){
		case abs_ST:	if(i<0)i=-i; put_int(i); return;
		case min_ST:	i=-i; put_int(i); return;
		case plus_ST:	put_int(i); return;
		case sign_ST:	i=i<0?-1:i?1:0; put_int(i); return;
		case odd_ST:	put_bool((int)(i & 1)); return;
		case repr_ST:	put_char((int)i); return;
		case bin_ST:	put_bits(i); return;}
	  case REAL:	get_real(u); switch(op){
		case sign_ST:	i=re1<0.0?-1:re1>0.0?1:0; put_int(i); return;
		case entier_ST:	i=(inta)floor(re1); put_int(i); return;
		case round_ST:	i=(inta)floor(re1+.5); put_int(i); return;
		case abs_ST:	put_real(fabs(re1)); return;
		case min_ST:	put_real(-re1); return;
		case plus_ST:	put_real(re1); return;
		default:	math_func(op); return;}
	  case ROW:	j=B[u]; switch(op){
		case upb_ST:	i=B[j+1]; put_int(i); return;
		case lwb_ST:	i=A[j+1]; put_int(i); return;
		case bitspack_ST: bitspack(j); return;}
	  case CHAR:	i=B[u]; put_int(i); return; /*repr_ST*/
	  case BOOL:	j=B[u]; switch(op){
		case abs_ST:	put_int((inta)j); return;
		case not_ST:	put_bool(!j); return;}
	  case BITS:	i=get_bits(u); switch(op){
		case abs_ST:	put_int(i); return;
		case not_ST:	i = ~i; put_bits(i); return;}
	  case STRUCT:	get_real(B[B[u]+1]); im1=re1; get_real(B[B[u]]);
			switch(op){
		case re_ST:	put_real(re1); return;
		case im_ST:	put_real(im1); return;
		case conj_ST:	put_complex(re1,-im1); return;
		case abs_ST:	put_real(hypot(re1,im1)); return;
		case arg_ST:	put_real(atan2(re1,im1)); return;
		case min_ST:	put_complex(-re1,-im1); return;
		case plus_ST:	put_complex(re1,im1); return;}
	}
}

void standard_dyadic(op,v1,v2) int op,v1,v2;
{	if(ab_bool_cmp_ST(op)){
	    if(ab_bool_ST(op)){
		if( ab_ST(op)){
		    if(op==plusto_ST)plusto_op(v1,v2);else ab_op(op,v1,v2);
		}else{
		    bool_op(op,v1,v2);}
	    }else{
		cmp_op(op,v1,v2);}
	}else if(aritm_ST(op)){
	    aritm_op(op,v1,v2);
	}else if(updown_ST(op)){
	    updown_op(op,v1,v2);
	}else if(op==plit_ST){
	    plit_op(v1,v2);
	}else{bound_op(op,v1,v2);}
}

static bool get_reals(v1,v2) int v1,v2;
{	if(get_real(v2)){re2=re1; return(get_real(v1));}
	return(FALSE);
}

static bool get_complexs(v1,v2) int v1,v2;
{	if(get_complex(v2)){re2=re1; im2=im1; return(get_complex(v1));}
	return(FALSE);
}

static void complex_op(op) int op;
{double d;
	switch(op){
	    case plusab_ST: case plus_ST:
		put_complex(re1+re2,im1+im2); return;
	    case minab_ST: case min_ST:
		put_complex(re1-re2,im1-im2); return;
	    case timeab_ST: case times_ST:
		put_complex(re1*re2-im1*im2,re1*im2+re2*im1); return;
	    case divab_ST: case div_ST:
		d=re2*re2+im2*im2;
		put_complex((re1*re2+im1*im2)/d,(im1*re2-im2*re1)/d); return;
	}
}

static int fe1,fe2,len1,len2,off1,off2;

static void get_string(v) int v;
{int bv;
	if(A[v]==ROW){
	    bv=B[v]; fe1=B[bv]; len1=C[bv]; off1=C[bv+1];
	}else if(A[v]==CHAR){
	    fe1=v; len1=off1=1;}
}

static void get_strings(v1,v2) int v1,v2;
{	get_string(v2); fe2=fe1; len2=len1; off2=off1; get_string(v1);
}

static void copy_string(fe,len,offst,v) int fe,len,offst,v;
{register int i;
	for(i=0;i<len;i++){copy(fe,v+i); fe += offst;}
}

static int compare_strings()
{register int k,i;
	for(i=0;i<len1&&i<len2;i++){
	    if(k=B[fe1]-B[fe2]) return(k);fe1+=off1;fe2+=off2;
	}
	return(len1-len2);
}

static void string_sum()
{int n;
	n=len1+len2; A[Z=askn(n+3)]=ROW; B[Z]=Z+1; C[Z]=0;
	A[Z+1]=1; B[Z+1]=Z+3; C[Z+1]=n; A[Z+2]=1; B[Z+2]=n; C[Z+2]=1;
	if(n){copy_string(fe1,len1,off1,Z+3);
	      copy_string(fe2,len2,off2,Z+3+len1);}
	else{ more_instance(B[Z+1]=char_mode);}
}

static void string_mult(t) inta t;
{int i,n;
	must(t<0x4000,723); n= t<0 ? 0 : ((int)t)*len1;
	A[Z=askn(n+3)]=ROW; C[Z]=0;
	A[B[Z]=Z+1]=A[Z+2]=C[Z+2]=1; B[Z+1]=Z+3; C[Z+1]=B[Z+2]=n;
	if(n){for(i=Z+3;i<Z+3+n;i +=len1)copy_string(fe1,len1,off1,i);}
	else{ more_instance(B[Z+1]=char_mode);}
}

void plusto_op(v1,v2) int v1,v2; /* string +=: ref string */
{	must(C[v2]>0,721); must(C[B[v2]]==0,722); /* flexibile */
	get_strings(v1,B[v2]); string_sum();
	replace(Z,B[v2]); Z=new_reference(B[v2]);
}

void ab_op(op,v1,v2) int op,v1,v2; /* v1 op:= v2 */
{int bv1; inta i,j;
	must(C[v1]>0,731); bv1=B[v1]; switch(A[bv1]){
	case INT:
	    i=get_int(bv1); j=get_int(v2); switch(op){
		case plusab_ST:		i += j; break;
		case minab_ST:		i -= j; break;
		case timeab_ST:		i *= j; break;
		case overab_ST:		i /= j; break;
		case modab_ST:		i %= j; break; /*** maybe wrong ***/
	    } put_int(i); break;
	case REAL:
	    get_reals(bv1,v2); switch(op){
		case plusab_ST:		re1 += re2; break;
		case minab_ST:		re1 -= re2; break;
		case timeab_ST:		re1 *= re2; break;
		case divab_ST:		re1 /= re2; break;
	    } put_real(re1); break;
	case STRUCT:
	    get_complexs(bv1,v2); complex_op(op); break;
	case ROW:   /* string +:= string or string *:= int */
	    must(C[bv1]==0,732); get_strings(bv1,v2);
	    if(A[v2]==INT)string_mult(get_int(v2));else string_sum(); break;
	}
	replace(Z,bv1); Z=new_reference(bv1);
}

void bool_op(op,v1,v2) int op,v1,v2;
{inta i,j;
    if(A[v1]==BOOL){
       put_bool(op==or_ST?B[v1]|B[v2]:B[v1]&B[v2]);
    } else { /* A[v1]==BITS */
        i=get_bits(v1); j=get_bits(v2);
        put_bits(op==or_ST?i|j:i&j);
    }
}

void cmp_op(op,v1,v2) int op,v1,v2;
{inta i,j; bool b; int res;
	if(A[v1]==INT && A[v2]==INT){i=get_int(v1); j=get_int(v2); switch(op){
	    case eq_ST: 	b= i==j; break;
	    case ne_ST: 	b= i!=j; break;
	    case less_ST:	b= i<j;  break;
	    case greater_ST:	b= i>j;  break;
	    case le_ST:		b= i<=j; break;
	    case ge_ST:		b= i>=j; break;}
	    put_bool(b); return;
	}
	if(A[v1]==BOOL){
	    put_bool((op==eq_ST)^(B[v1]!=B[v2])); return;}
	if(A[v1]==BITS){i=get_bits(v1); j=get_bits(v2); switch(op){
	    case eq_ST:		b= i==j; break;
	    case ne_ST:		b= i!=j; break;
	    case le_ST:		b= j==(i|j); break;
	    case ge_ST:		b= i==(i|j); break;}
	    put_bool(b); return;
	}
	if(get_reals(v1,v2)){ switch(op){
	    case eq_ST: 	b= re1==re2; break;
	    case ne_ST: 	b= re1!=re2; break;
	    case less_ST:	b= re1<re2;  break;
	    case greater_ST:	b= re1>re2;  break;
	    case le_ST:		b= re1<=re2; break;
	    case ge_ST:		b= re1>=re2; break;}
	    put_bool(b); return;
	}
	if(get_complexs(v1,v2)){ b= re1==re2 && im1==im2;
	    put_bool(op==eq_ST?b:!b); return;
	}
	get_strings(v1,v2); res=compare_strings(); switch(op){
	    case eq_ST: 	b= res==0; break;
	    case ne_ST: 	b= res!=0; break;
	    case less_ST:	b= res<0;  break;
	    case greater_ST:	b= res>0;  break;
	    case le_ST:		b= res<=0; break;
	    case ge_ST:		b= res>=0; break;}
	put_bool(b); return;
}

void aritm_op(op,v1,v2) int op,v1,v2;
{inta i,j;
	if(A[v1]==INT && A[v2]==INT){i=get_int(v1); j=get_int(v2); switch(op){
	    case plus_ST:	i += j; break;
	    case min_ST:	i -= j; break;
	    case times_ST:	i *= j; break;
	    case div_ST:	put_real((double)i/(double)j); return;
	    case over_ST:	i /= j; break;
	    case mod_ST:	i %= j; break;   /*** maybe wrong ***/
	    } put_int(i); return;
	}
	if(get_reals(v1,v2)){ switch(op){
	    case plus_ST:	re1 += re2; break;
	    case min_ST:	re1 -= re2; break;
	    case times_ST:	re1 *= re2; break;
	    case div_ST:	re1 /= re2; break;
	    } put_real(re1); return;
	}
	if(get_complexs(v1,v2)){complex_op(op); return;}
	if(op==plus_ST){get_strings(v1,v2); string_sum(); return;}
	if(op==elem_ST){
	    i=get_int(v1); put_bool(i<0||i>31?0:1&(B[v2]>>(31-i))); return;
	}
	if(A[v1]==INT){get_string(v2); string_mult(get_int(v1));}
	    else{get_string(v1); string_mult(get_int(v2));}
}

void updown_op(op,v1,v2) int op,v1,v2;
{inta m,n,p,i; double re;
	m=get_int(v2); n=m<0?-m:m; switch(A[v1]){
	    case INT:
		i=get_int(v1); p=1; while(n){if(n&1)p *= i; i *=i; n >>= 1;}
		if(m<0)p=1/p; put_int(p); return;
	    case REAL:
		get_real(v1); re2=1.0;
		while(n){if(n&1)re2 *= re1; re1 *= re1; n >>= 1;}
		put_real(m<0?1.0/re2:re2); return;
	    case STRUCT:
		get_complex(v1); re2=1.0; im2=0.0;
		while(n){
		    if(n&1){
			re=re1*re2-im1*im2; im2=re1*im2+re2*im1; re2=re;}
		    re=re1*re1-im1*im1; im1=2*re1*im1; re1=re; n>>= 1;
		}
		if(m<0){re=re2*re2+im2*im2; put_complex(re2/re,-im2/re);}
		else{ put_complex(re2,im2);} return;
	    case BITS:
		i=get_bits(v1);i=n>31 ? 0 : (m<0)==(op==up_ST)? i>>n : i<<n;
		put_bits(i);
		return;
	}
}

void plit_op(v1,v2) int v1,v2;
{	get_real(v2); im1=re1; get_real(v1); put_complex(re1,im1);
}

void bound_op(op,v1,v2) int op,v1,v2;
{int i,bv;
        i=get_int(v1); must(0<i,741); must(i<=A[bv=B[v2]],742);
	i=op==lwb_ST?A[bv+i]:B[bv+i];
	put_int((inta)i);
}