The version of basic copied from Martin Kerstens directory.
This commit is contained in:
em
214
lang/basic/src.old/func.c
Normal file
214
lang/basic/src.old/func.c
Normal file
@@ -0,0 +1,214 @@
|
||||
#include "bem.h"
|
||||
|
||||
/* expression types for predefined functions are assembled */
|
||||
int typetable[10];
|
||||
int exprlimit;
|
||||
|
||||
/* handle all predefined functions */
|
||||
#define cv(X) conversion(type,X); pop=X
|
||||
#define cl(X) emcode("cal",X);
|
||||
|
||||
parm(cnt)
|
||||
int cnt;
|
||||
{
|
||||
if( cnt> exprlimit)
|
||||
error("Not enough arguments");
|
||||
if( cnt < exprlimit)
|
||||
error("Too many arguments");
|
||||
}
|
||||
|
||||
callfcn(fcnnr,cnt)
|
||||
int fcnnr,cnt;
|
||||
{
|
||||
int pop=DOUBLETYPE;
|
||||
int res=DOUBLETYPE;
|
||||
int type;
|
||||
|
||||
|
||||
type= typetable[0];
|
||||
exprlimit=cnt;
|
||||
if(debug) printf("fcn=%d\n",fcnnr);
|
||||
switch(fcnnr)
|
||||
{
|
||||
case ABSSYM: cv(DOUBLETYPE);
|
||||
cl("$_abr");
|
||||
parm(1);
|
||||
break;
|
||||
case ASCSYM: cv(STRINGTYPE);
|
||||
cl("$_asc"); res=INTTYPE;
|
||||
parm(1);
|
||||
break;
|
||||
case ATNSYM: cv(DOUBLETYPE);
|
||||
cl("$_atn");
|
||||
parm(1);
|
||||
break;
|
||||
case CDBLSYM: cv(DOUBLETYPE); return(DOUBLETYPE);;
|
||||
case CHRSYM: cv(INTTYPE);
|
||||
cl("$_chr"); res=STRINGTYPE;
|
||||
parm(1);
|
||||
break;
|
||||
case CSNGSYM:
|
||||
cv(DOUBLETYPE); return(DOUBLETYPE);
|
||||
case CINTSYM: cv(INTTYPE); return(INTTYPE);
|
||||
case COSSYM: cv(DOUBLETYPE);
|
||||
cl("$_cos");
|
||||
parm(1);
|
||||
break;
|
||||
case CVISYM: cv(STRINGTYPE);
|
||||
cl("$_cvi"); res=INTTYPE;
|
||||
parm(1);
|
||||
break;
|
||||
case CVSSYM: cv(STRINGTYPE);
|
||||
cl("$_cvd"); res=DOUBLETYPE;
|
||||
parm(1);
|
||||
break;
|
||||
case CVDSYM: cv(STRINGTYPE);
|
||||
cl("$_cvd"); res=DOUBLETYPE;
|
||||
parm(1);
|
||||
break;
|
||||
case EOFSYM:
|
||||
if( cnt==0)
|
||||
{
|
||||
res= INTTYPE;
|
||||
pop= INTTYPE;
|
||||
emcode("loc","-1");
|
||||
} else cv(INTTYPE);
|
||||
cl("$_ioeof"); res=INTTYPE;
|
||||
break;
|
||||
case EXPSYM: cv(DOUBLETYPE);
|
||||
cl("$_exp");
|
||||
parm(1);
|
||||
break;
|
||||
case FIXSYM: cv(DOUBLETYPE);
|
||||
cl("$_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);
|
||||
cl("$_hex"); res=STRINGTYPE;
|
||||
parm(1);
|
||||
break;
|
||||
case OUTSYM:
|
||||
case INSTRSYM: cv(DOUBLETYPE);
|
||||
cl("$_instr"); res=STRINGTYPE;
|
||||
parm(1);
|
||||
break;
|
||||
case INTSYM: cv(DOUBLETYPE);
|
||||
cl("$_fcint");
|
||||
parm(1);
|
||||
break;
|
||||
case LEFTSYM: parm(2);
|
||||
extraconvert(type, STRINGTYPE,typetable[1]);
|
||||
type= typetable[1];
|
||||
cv(INTTYPE);
|
||||
cl("$_left"); res=STRINGTYPE;
|
||||
emcode("asp",EMPTRSIZE);
|
||||
emcode("asp",EMINTSIZE);
|
||||
emcode("lfr",EMPTRSIZE);
|
||||
return(STRINGTYPE);
|
||||
case LENSYM: cv(STRINGTYPE);
|
||||
cl("$_len"); res=INTTYPE;
|
||||
parm(1);
|
||||
break;
|
||||
case LOCSYM: cv(INTTYPE);
|
||||
cl("$_loc"); res=INTTYPE;
|
||||
parm(1);
|
||||
break;
|
||||
case LOGSYM: cv(DOUBLETYPE);
|
||||
cl("$_log");
|
||||
parm(1);
|
||||
break;
|
||||
case MKISYM: cv(INTTYPE);
|
||||
cl("$_mki"); res=STRINGTYPE;
|
||||
parm(1);
|
||||
break;
|
||||
case MKSSYM: cv(DOUBLETYPE);
|
||||
cl("$_mkd"); res=STRINGTYPE;
|
||||
parm(1);
|
||||
break;
|
||||
case MKDSYM: cv(DOUBLETYPE);
|
||||
cl("$_mkd"); res=STRINGTYPE;
|
||||
parm(1);
|
||||
break;
|
||||
case OCTSYM: cv(INTTYPE);
|
||||
cl("$_oct"); res=STRINGTYPE;
|
||||
parm(1);
|
||||
break;
|
||||
case PEEKSYM: cv(INTTYPE);
|
||||
cl("$_peek"); res=INTTYPE;
|
||||
parm(1);
|
||||
break;
|
||||
case POSSYM: emcode("asp",typestring(type));
|
||||
emcode("exa","_pos");
|
||||
emcode("loe","_pos");
|
||||
return(INTTYPE);
|
||||
case RIGHTSYM: parm(2);
|
||||
extraconvert(type, STRINGTYPE,typetable[1]);
|
||||
type= typetable[1];
|
||||
cv(INTTYPE);
|
||||
cl("$_right"); res=STRINGTYPE;
|
||||
emcode("asp",EMINTSIZE);
|
||||
emcode("asp",EMPTRSIZE);
|
||||
emcode("lfr",EMPTRSIZE);
|
||||
return(STRINGTYPE);
|
||||
case RNDSYM: if( cnt==1) pop=type; else pop=0;
|
||||
cl("$_rnd"); res= DOUBLETYPE;
|
||||
break;
|
||||
case SGNSYM: cv(DOUBLETYPE);
|
||||
cl("$_sgn"); res=INTTYPE;
|
||||
parm(1);
|
||||
break;
|
||||
case SINSYM: cv(DOUBLETYPE);
|
||||
cl("$_sin");
|
||||
parm(1);
|
||||
break;
|
||||
case SPACESYM: cv(INTTYPE);
|
||||
cl("$_space"); res=STRINGTYPE;
|
||||
parm(1);
|
||||
break;
|
||||
case SPCSYM: cv(INTTYPE);
|
||||
cl("$_spc"); res=0;
|
||||
parm(1);
|
||||
break;
|
||||
case SQRSYM: cv(DOUBLETYPE);
|
||||
cl("$_sqt");
|
||||
parm(1);
|
||||
break;
|
||||
case STRSYM: cv(DOUBLETYPE);
|
||||
cl("$_str");
|
||||
parm(1);
|
||||
break;
|
||||
case STRINGSYM: cv(STRINGTYPE);
|
||||
cl("$_string"); res=STRINGTYPE;
|
||||
parm(1);
|
||||
break;
|
||||
case TABSYM: cv(INTTYPE);
|
||||
cl("$_tab"); res=0;
|
||||
parm(1);
|
||||
break;
|
||||
case TANSYM: cv(DOUBLETYPE);
|
||||
cl("$_tan");
|
||||
parm(1);
|
||||
break;
|
||||
case VALSYM: cv(STRINGTYPE);
|
||||
cl("$atol"); res=INTTYPE;
|
||||
parm(1);
|
||||
break;
|
||||
case VARPTRSYM: cv(DOUBLETYPE);
|
||||
cl("$_valptr");
|
||||
parm(1);
|
||||
break;
|
||||
default: error("unknown function");
|
||||
}
|
||||
if(pop)
|
||||
emcode("asp",typestring(pop));
|
||||
if(res)
|
||||
emcode("lfr",typestring(res));
|
||||
return(res);
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user