270 lines
5.5 KiB
C
270 lines
5.5 KiB
C
|
/*
|
||
|
|
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
|
||
|
|
* See the copyright notice in the ACK home directory, in the file "Copyright".
|
||
|
|
*/
|
||
|
|
|
||
|
|
#include "bem.h"
|
||
|
|
|
||
|
|
#ifndef NORSCID
|
||
|
|
static char rcs_id[] = "$Header$" ;
|
||
|
|
#endif
|
||
|
|
|
||
|
|
|
||
|
|
/* expression types for predefined functions are assembled */
|
||
|
|
int typetable[10];
|
||
|
|
int exprlimit;
|
||
|
|
|
||
|
|
/* handle all predefined functions */
|
||
|
|
#define cv(X) conversion(type,X); pop=X
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
parm(cnt)
|
||
|
|
int cnt;
|
||
|
|
{
|
||
|
|
if( cnt> exprlimit)
|
||
|
|
error("Not enough arguments");
|
||
|
|
if( cnt < exprlimit)
|
||
|
|
error("Too many arguments");
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
callfcn(fcnnr,cnt,typetable)
|
||
|
|
int fcnnr,cnt;
|
||
|
|
int *typetable;
|
||
|
|
{
|
||
|
|
int pop=DOUBLETYPE;
|
||
|
|
int res=DOUBLETYPE;
|
||
|
|
int type;
|
||
|
|
|
||
|
|
|
||
|
|
type= typetable[0];
|
||
|
|
exprlimit=cnt;
|
||
|
|
if(debug) print("fcn=%d\n",fcnnr);
|
||
|
|
|
||
|
|
switch(fcnnr)
|
||
|
|
{
|
||
|
|
case ABSSYM: cv(DOUBLETYPE);
|
||
|
|
C_cal("_abr");
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case ASCSYM: cv(STRINGTYPE);
|
||
|
|
C_cal("_asc");
|
||
|
|
res=INTTYPE;
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case ATNSYM: cv(DOUBLETYPE);
|
||
|
|
C_cal("_atn");
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case CDBLSYM: cv(DOUBLETYPE);
|
||
|
|
return(DOUBLETYPE);;
|
||
|
|
case CHRSYM: cv(INTTYPE);
|
||
|
|
C_cal("_chr");
|
||
|
|
res=STRINGTYPE;
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case CSNGSYM: cv(DOUBLETYPE);
|
||
|
|
return(DOUBLETYPE);
|
||
|
|
case CINTSYM: cv(INTTYPE);
|
||
|
|
return(INTTYPE);
|
||
|
|
case COSSYM: cv(DOUBLETYPE);
|
||
|
|
C_cal("_cos");
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case CVISYM: cv(STRINGTYPE);
|
||
|
|
C_cal("_cvi");
|
||
|
|
res=INTTYPE;
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case CVSSYM: cv(STRINGTYPE);
|
||
|
|
C_cal("_cvd");
|
||
|
|
res=DOUBLETYPE;
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case CVDSYM: cv(STRINGTYPE);
|
||
|
|
C_cal("_cvd");
|
||
|
|
res=DOUBLETYPE;
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case EOFSYM:
|
||
|
|
if( cnt==0)
|
||
|
|
{
|
||
|
|
res= INTTYPE;
|
||
|
|
pop= INTTYPE;
|
||
|
|
C_loc((arith) -1);
|
||
|
|
} else cv(INTTYPE);
|
||
|
|
C_cal("_ioeof");
|
||
|
|
res=INTTYPE;
|
||
|
|
break;
|
||
|
|
case EXPSYM: cv(DOUBLETYPE);
|
||
|
|
C_cal("_exp");
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case FIXSYM: cv(DOUBLETYPE);
|
||
|
|
C_cal("_fix");
|
||
|
|
res=INTTYPE;
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case INPSYM:
|
||
|
|
case LPOSSYM:
|
||
|
|
case FRESYM: pop=0;
|
||
|
|
warning("function not supported");
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case HEXSYM: cv(INTTYPE);
|
||
|
|
C_cal("_hex"); res=STRINGTYPE;
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case OUTSYM:
|
||
|
|
case INSTRSYM: cv(DOUBLETYPE);
|
||
|
|
C_cal("_instr");
|
||
|
|
res=STRINGTYPE;
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case INTSYM: cv(DOUBLETYPE);
|
||
|
|
C_cal("_fcint");
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case LEFTSYM: parm(2);
|
||
|
|
extraconvert(type, STRINGTYPE,typetable[1]);
|
||
|
|
type= typetable[1];
|
||
|
|
cv(INTTYPE);
|
||
|
|
C_cal("_left");
|
||
|
|
res=STRINGTYPE;
|
||
|
|
C_asp((arith) BEMPTRSIZE);
|
||
|
|
C_asp((arith) BEMINTSIZE);
|
||
|
|
C_lfr((arith) BEMPTRSIZE);
|
||
|
|
return(STRINGTYPE);
|
||
|
|
case LENSYM: cv(STRINGTYPE);
|
||
|
|
C_cal("_len");
|
||
|
|
res=INTTYPE;
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case LOCSYM: cv(INTTYPE);
|
||
|
|
C_cal("_loc");
|
||
|
|
res=INTTYPE;
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case LOGSYM: cv(DOUBLETYPE);
|
||
|
|
C_cal("_log");
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case MKISYM: cv(INTTYPE);
|
||
|
|
C_cal("_mki");
|
||
|
|
res=STRINGTYPE;
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case MKSSYM: cv(DOUBLETYPE);
|
||
|
|
C_cal("_mkd");
|
||
|
|
res=STRINGTYPE;
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case MKDSYM: cv(DOUBLETYPE);
|
||
|
|
C_cal("_mkd");
|
||
|
|
res=STRINGTYPE;
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case OCTSYM: cv(INTTYPE);
|
||
|
|
C_cal("_oct");
|
||
|
|
res=STRINGTYPE;
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case PEEKSYM: cv(INTTYPE);
|
||
|
|
C_cal("_peek");
|
||
|
|
res=INTTYPE;
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case POSSYM: C_asp((arith) typestring(type));
|
||
|
|
C_exa_dnam("_pos");
|
||
|
|
C_loe_dnam("_pos",(arith) 0);
|
||
|
|
return(INTTYPE);
|
||
|
|
case RIGHTSYM: parm(2);
|
||
|
|
extraconvert(type, STRINGTYPE,typetable[1]);
|
||
|
|
type= typetable[1];
|
||
|
|
cv(INTTYPE);
|
||
|
|
C_cal("_right");
|
||
|
|
res=STRINGTYPE;
|
||
|
|
C_asp((arith) BEMINTSIZE);
|
||
|
|
C_asp((arith) BEMPTRSIZE);
|
||
|
|
C_lfr((arith) BEMPTRSIZE);
|
||
|
|
return(STRINGTYPE);
|
||
|
|
case RNDSYM: if( cnt==1) pop=type;
|
||
|
|
else pop=0;
|
||
|
|
C_cal("_rnd");
|
||
|
|
res= DOUBLETYPE;
|
||
|
|
break;
|
||
|
|
case SGNSYM: cv(DOUBLETYPE);
|
||
|
|
C_cal("_sgn");
|
||
|
|
res=INTTYPE;
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case SINSYM: cv(DOUBLETYPE);
|
||
|
|
C_cal("_sin");
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case SPACESYM: cv(INTTYPE);
|
||
|
|
C_cal("_space");
|
||
|
|
res=STRINGTYPE;
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case SPCSYM: cv(INTTYPE);
|
||
|
|
C_cal("_spc");
|
||
|
|
res=0;
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case SQRSYM: cv(DOUBLETYPE);
|
||
|
|
C_cal("_sqt");
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case STRSYM: cv(DOUBLETYPE);
|
||
|
|
C_cal("_nstr");
|
||
|
|
res=STRINGTYPE; /* NEW */
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case STRINGSYM:
|
||
|
|
parm(2); /* 2 is NEW */
|
||
|
|
if (typetable[1] == STRINGTYPE) {
|
||
|
|
C_cal("_asc");
|
||
|
|
C_asp((arith)BEMPTRSIZE);
|
||
|
|
C_lfr((arith)BEMINTSIZE);
|
||
|
|
typetable[1] = INTTYPE;
|
||
|
|
}
|
||
|
|
extraconvert(type,
|
||
|
|
DOUBLETYPE,
|
||
|
|
typetable[1]); /* NEW */
|
||
|
|
type= typetable[1];
|
||
|
|
cv(DOUBLETYPE); /* NEW */
|
||
|
|
C_cal("_string");
|
||
|
|
res=STRINGTYPE;
|
||
|
|
C_asp((arith)typestring(DOUBLETYPE)); /*NEW*/
|
||
|
|
break;
|
||
|
|
case TABSYM: cv(INTTYPE);
|
||
|
|
C_cal("_tab");
|
||
|
|
res=0;
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case TANSYM: cv(DOUBLETYPE);
|
||
|
|
C_cal("_tan");
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case VALSYM: cv(STRINGTYPE);
|
||
|
|
C_loi((arith)BEMPTRSIZE);
|
||
|
|
C_cal("atoi");
|
||
|
|
res=INTTYPE;
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
case VARPTRSYM: cv(DOUBLETYPE);
|
||
|
|
C_cal("_valptr");
|
||
|
|
parm(1);
|
||
|
|
break;
|
||
|
|
default: error("unknown function");
|
||
|
|
}
|
||
|
|
|
||
|
|
if(pop) C_asp((arith) typestring(pop));
|
||
|
|
if(res) C_lfr((arith) typestring(res));
|
||
|
|
return(res);
|
||
|
|
}
|
||
|
|
|