Initial revision
This commit is contained in:
ceriel
269
lang/basic/src/func.c
Normal file
269
lang/basic/src/func.c
Normal file
@@ -0,0 +1,269 @@
|
||||
/*
|
||||
* (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);
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user