/*
* BASIC by Phil Cockcroft
*/
/*
* This file contains the main routines of the interpreter.
*/
/*
* the core is arranged as follows: -
* ------------------------------------------------------------------- - - -
* | file | text | string | user | array | simple | for/ | unused
* | buffers | of | space | def | space | variables | gosub | memory
* | | program | | fns | | | stack |
* ------------------------------------------------------------------- - - -
* ^ ^ ^ ^ ^ ^ ^ ^
* filestart fendcore ecore estring edefns earray vend vvend
* ^eostring ^estarr
*/
#define PART1
#include "bas.h"
#undef PART1
extern void _exit();
#ifdef __STDC__
static CHAR *eql(CHAR *, CHAR *, CHAR *);
static void docont(void);
static void free_ar(struct entry *);
static SIGFUNC trap(int), seger(int), mcore(int), quit1(int), catchfp(int);
#ifdef SIGTSTP
static SIGFUNC onstop(int);
#endif
#ifdef OWN_ALLOC
extern void *m_get(unsigned int);
extern void m_free(void *);
extern void m_purge(void);
#endif
#else
static CHAR *eql();
static void docont();
static void free_ar();
static SIGFUNC trap(), seger(), mcore(), quit1(), catchfp();
#ifdef SIGTSTP
static SIGFUNC onstop();
#endif
#ifdef OWN_ALLOC
extern void *m_get();
extern void m_free();
extern void m_purge();
#endif
#endif
#ifdef MSDOS
static int lcount;
#endif
/*
* The main program , it sets up all the files, signals,terminal
* and pointers and prints the start up message.
* It then calls setexit().
* IMPORTANT NOTE:-
* setexit() sets up a point of return for a function
* It saves the local environment of the calling routine
* and uses that environment for further use.
* The function reset() uses the information saved in
* setexit() to perform a non-local goto , e.g. poping the stack
* until it looks as though it is a return from setexit()
* The program then continues as if it has just executed setexit()
* This facility is used all over the program as a way of getting
* out of functions and returning to command mode.
* The one exception to this is during error trapping , The error
* routine must pop the stack so that there is not a recursive call
* on execute() but if it does then it looks like we are back in
* command mode. The flag ertrap is used to signal that we want to
* go straight on to execute() the error trapping code. The pointers
* must be set up before the execution of the reset() , (see error ).
* N.B. reset() NEVER returns , so error() NEVER returns.
*/
main(argc,argv)
char **argv;
{
register int i = 0;
catchsignal();
startfp(); /* start up the floating point hardware */
setupfiles(argc,argv);
setupmyterm(); /* set up files after processing files */
program = 0;
clear();
prints("Rabbit Basic version v2.0\n");
if(setexit() == ERR_RESET){
drop_fns();
execute(); /* execute the line */
}
drop_fns();
docont();
stocurlin=0; /* say we are in immeadiate mode */
if(cursor) /* put cursor on a blank line */
prints( (char *)nl);
prints("Ready\n");
for(;;){
do{
trapped=0;
*line ='>';
VOID edit( (ival)1, (ival)1, (ival)0);
}while( trapped || ( !(i=compile(1, nline, 0)) && !linenumber));
if(!linenumber)
break;
insert(i);
}
if(inserted){
inserted=0;
clear();
closeall();
}
#ifdef MSDOS
lcount = 0;
#endif
clr_stack(bstack); /* reset the gosub stack */
bstack = estack = 0;
if(str_used) /* free any spare strings */
FREE_STR(str_used);
trap_env.e_stolin = 0; /* disable error traps */
intrap=0; /* say we are not in the error trap */
trapped=0; /* say we haven't got a cntrl-c */
cursor=0; /* cursor is at start of line */
elsecount=0; /* disallow elses as terminators */
point=nline; /* start executing at start of input line */
stocurlin=0; /* start of current line is null- see 'next' */
execute(); /* execute the line */
return(-1); /* see note below */
}
/*
* Execute will return by calling reset and so if execute returns then
* there is a catastrophic error and we should exit with -1 or something
*/
/*
* compile converts the input line (in line[]) into tokenised
* form for execution(in nline). If the line starts with a linenumber
* then that is converted to binary and is stored in 'linenumber' N.B.
* not curline (see evalu() ). A linenumber of zero is assumed to
* be non existant and so the line is executed immeadiately.
* The parameter to compile() is an index into line that is to be
* ignored, e.g. the prompt.
*/
int
compile(fl, fline, hasnolnumb)
int fl, hasnolnumb;
CHAR *fline;
{
register CHAR *p, *k, *q;
register const struct tabl *l;
lnumb lin=0;
CHAR *tmp;
CHAR charac;
p= &line[fl];
q=fline;
while(*p ==' ')
p++;
if(!hasnolnumb){
/*LINTED*/
while(ispnumber(p)){ /* get line number */
if(lin >= 6553)
error(7);
lin = lin*10 + (*p++ -'0');
}
while(*p==' ')
*q++ = *p++;
}
if(!*p){
*q = 0;
linenumber =lin;
return(0); /* no characters on the line */
}
while(*p){
/*LINTED*/
if(!ispletter(p)){
/* not a keyword. check for special characters */
switch(*p++){
case '"':
case '`': /* quoted strings */
*q++ = charac = *(p-1);
while(*p && *p != charac)
*q++ = *p++;
if(*p)
*q++ = *p++;
continue;
case '?':
*q++ = (CHAR)QPRINT;
continue;
case '\'': /* a rem statement */
*q++ = (CHAR)QUOTE;
while(*p)
*q++ = *p++;
continue;
case '<':
if(*p == '='){
*q++ = (CHAR)LTEQ;
p++;
continue;
}
if(*p == '>'){
*q++ = (CHAR)NEQE;
p++;
continue;
}
break;
case '>':
if(*p == '='){
*q++ = (CHAR)GTEQ;
p++;
continue;
}
break;
case '=':
if(*p == '='){
*q++ = (CHAR)APRX;
p++;
continue;
}
break;
}
*q++ = *(p-1);
continue;
}
/*
* now do a quick check on the first character
*/
charac = lcase(*p);
for(l = table ; l->string ; l++)
if(charac == *l->string)
break;
/*
* not found. not a keyword
*/
if(l->string == 0){
*q++ = *p++;
/*LINTED*/
while(ispletter(p))
*q++ = *p++;
continue;
}
/*
* get the length of the word
*/
/*LINTED*/
for(k = p, p++ ; ispcchar(p); p++);
/* special case for FN */
if(p >= k + 2 && charac == 'f' && lcase(k[1]) == 'n'){
/*
* and make certain it isn't fnend
*/
if(p != k+5 || lcase(k[2]) != 'e' ||
lcase(k[3]) != 'n' || lcase(k[4]) != 'd'){
*q++ = (CHAR)FN;
for(k += 2; k < p ;)
*q++ = *k++;
continue;
}
}
if(*p == '$')
p++;
/*
* check entry in the table
*/
for(; l->string ; l++)
if(charac == *l->string &&
(tmp = eql(k, (CHAR *)l->string, p)) != 0){
if(l->chval > 0377){
*q++ = (CHAR)(EXFUNC + (l->chval >> 8));
*q++ = (CHAR)(l->chval & MASK);
}
else
*q++ = (CHAR)l->chval;
p = tmp;
if(l->chval == DATA || l->chval == REM)
while(*p)
*q++ = *p++;
break;
}
if(!l->string)
while(k < p)
*q++ = *k++;
}
*q='\0';
linenumber=lin;
return(q-fline); /* return length of line */
}
/*
* eql() returns true if the strings are the same .
* this routine is only called if the first letters are the same.
* hence the increment of the pointers , we don't need to compare
* the characters they point to.
* To increase speed this routine could be put into machine code
* the overheads on the function call and return are excessive
* for what it accomplishes. (it fails most of the time , and
* it can take a long time to load a large program ).
*/
static CHAR *
eql(p, q, end)
register CHAR *p, *q, *end;
{
p++, q++;
while(p < end){
if(*p != *q && lcase(*p) != lcase(*q))
return(0);
p++, q++;
}
#ifndef NO_SCOMMS
if(*p == '.' && *q)
return(p + 1);
#endif
if(*q)
return(0);
return(p);
}
/*
* Puts a line in the table of lines then sets a flag (inserted) so that
* the variables are cleared , since it is very likely to have moved
* 'ecore' and so the variables will all be corrupted. The clearing
* of the variables is not done in this routine since it is only needed
* to clear the variables once and that is best accomplished in main
* just before it executes the immeadiate mode line.
* If the line existed before this routine is called then it is deleted
* and then space is made available for the new line, which is then
* inserted.
* The structure of a line in memory has the following structure:-
* struct olin{
* unsigned linnumb;
* unsigned llen;
* char lin[1];
* }
* The linenumber of the line is stored in linnumb , If this is zero
* then this is the end of the program (all searches of the line table
* terminate if it finds the linenumber is zero.
* The variable 'llen' is used to store the length of the line (in
* characters including the above structure and any padding needed to
* make the line an even length.
* To search through the table of lines then:-
* XXXX g it as a variable
* length array ( impossible in 'pure' C ).
* The pointers used by the program storage routines are:-
* fendcore = start of text storage segment
* ecore = end of text storage
* = start of data segment (string space ).
* strings are stored after the text but before the numeric variables
* only 512 bytes are allocated at the start of the program for strings
* but clear can be called to get more core for the strings.
*/
void
insert(lsize)
int lsize;
{
register lpoint p, op;
register lnumb l;
inserted=1; /* say we want the variables cleared */
l= linenumber;
last_ins_line = 0;
for(op = 0, p = program; p ; op = p, p = p->next)
if(p->linnumb >= l){
if(p->linnumb != l){
if(p->linnumb == CONTLNUMB)
continue;
break;
}
if(!op)
program = p->next;
else
op->next = p->next;
mfree( (MEMP)p);
break;
}
if(!lsize) /* if no line to put in just ignore */
return;
ins_line(op, lsize);
}
void
ins_line(op, lsize)
lpoint op;
int lsize;
{
register lpoint p;
/* align the length */
/*
* no longer needed.
*
lsize = (lsize + sizeof(struct olin) + WORD_SIZ - 1) & ~WORD_MASK;
*/
lsize += sizeof(struct olin);
p = (lpoint) mmalloc((ival)lsize);
VOID str_cpy(nline, p->lin); /* move the line into the space */
p->linnumb = linenumber; /* give it a linenumber */
if(!op){
p->next = program;
program = p;
}
else {
p->next = op->next;
op->next = p;
}
last_ins_line = p;
}
/*
* The interpreter needs three variables to control the flow of the
* the program. These are:-
* stocurlin : This is the pointer to the start of the current
* line it is used to index the next line.
* If the program is in immeadiate mode then
* this variable is NULL (very important for 'next')
* point: This points to the current location that
* we are executing.
* curline: The current line number ( zero in immeadiate mode)
* this is not needed for program exection ,
* but is used in error etc. It could be made faster
* if this variable is not used....
*/
/*
* The main loop of the execution of a program.
* It does the following:-
* FOR(ever){
* save point so that resume will go to the right place
* IF cntrl-c THEN stop
* IF NOT a reserved word THEN do_assignment
* ELSE IF legal command THEN execute_command
* IF return is NORMAL THEN
* BEGIN
* IF terminator is ':' THEN continue
* ELSE IF terminator is '\0' THEN
* goto next line ; continue
* ELSE IF terminator is 'ELSE' AND
* 'ELSES' are enabled THEN
* goto next line ; continue
* END
* ELSE IF return is < NORMAL THEN continue
* ( used by goto etc. ).
* ELSE IF return is > NORMAL THEN
* ignore_rest_of_line ; goto next line ; continue
* }
* All commands return a value ( if they return ). This value is NORMAL
* if the command is standard and does not change the flow of the program.
* If the value is greater than zero then the command wants to miss the
* rest of the line ( comments and data ).
* If the value is less than zero then the program flow has changed
* and so we should go back and try to execute the new command ( we are
* now at the start of a command ).
*/
void
execute()
{
register int c, i;
register lpoint p;
for(;;){
#ifdef MSDOS
if(++lcount > 100){
lcount = 0;
if(CHK_KEY())
trap(0);
}
#endif
savepoint=point;
if(trapped)
dobreak();
if(tron_flag && stocurlin)
prsline("**", stocurlin);
if( ((c = getch()) & SPECIAL) == 0){
if(!c)
i = GTO;
else {
point--;
assign(ISFUNC|IS_MPR);
i = NORMAL;
}
}
else {
if(c >= MAXCOMMAND)
error(8);
i = (*commandf[c&0177])(); /* execute the command */
}
if(i == NORMAL){
if((c=getch())==':')
continue; /* `else` is a terminator */
if(c && (c != ELSE || !elsecount))
error(SYNTAX);
}
else if(i < NORMAL)
continue;
if(stocurlin){ /* not in immeadiate mode */
p = stocurlin->next; /* goto next line */
stocurlin=p;
if(p){
point=p->lin;
elsecount=0; /* disable `else`s */
continue;
}
}
break;
}
reset(); /* end of program */
}
/*
* save the current running environment
*/
void
save_env(e)
register struct env *e;
{
e->e_point = point;
e->e_stolin = stocurlin;
e->e_ertrap = trap_env.e_stolin;
e->e_elses = elsecount;
}
/*
* save the current running environment
*/
void
ret_env(e)
register struct env *e;
{
point = e->e_point;
stocurlin = e->e_stolin;
trap_env.e_stolin = e->e_ertrap;
elsecount = e->e_elses;
}
/*
* The error routine , this is called whenever there is any error
* it does some tidying up of file descriptors and sets the error line
* number and the error code. If there is error trapping ( errortrap is
* non-zero and in runmode ), then save the old pointers and set up the
* new pointers for the error trap routine.
* Otherwise print out the error message and the current line if in
* runmode.
* Finally call reset() ( which DOES NOT return ) to pop
* the stack and to return to the main routine.
*/
static const char _on_line_[] = " on line ";
void
error(i)
int i; /* error code */
{
register forstp fp;
if(newentry){
drop_val(newentry, 1);
newentry = 0;
}
if(readfile){ /* close file descriptor */
VOID close(readfile); /* from loading a file */
readfile=0;
}
if(lp_fd > 0){ /* close file for lprint */
VOID close(lp_fd);
lp_fd = 0;
}
if(renstr != 0){
mfree(renstr);
renstr = 0;
}
if(str_used)
FREE_STR(str_used);
evallock=0; /* stop the recursive eval message */
fnlock = 0;
ecode=i; /* set up the error code */
if(stocurlin)
elinnumb = getrline(stocurlin);/* set up the error line number*/
else
elinnumb=0;
/* we have error trapping */
if(stocurlin && trap_env.e_stolin && !inserted){
point = savepoint; /* go back to start of command */
save_env(&err_env);
ret_env(&trap_env);
intrap=1; /* say we are trapped */
/*
* return to enclosing function level. (if any)
*/
for(fp = estack ; fp ; fp = fp->prev)
if(fp->fortyp == FNTYP){
str_used = fp->fnSBEG;
str_uend = fp->fnSEND;
longjmp(fp->fnenv, ERR_RESET);
}
errreset(); /* no return - goes to main */
}
else { /* no error trapping */
if(cursor){
prints( (char *)nl);
cursor=0;
}
prints( (char *)ermesg[i-1]); /* error message */
if(stocurlin)
prsline(_on_line_, stocurlin);
prints( (char *)nl);
reset(); /* no return - goes to main */
}
}
void
c_error(err)
int err;
{
if(trap_env.e_stolin != 0 && stocurlin && !inserted)
error(err);
if(cursor){
prints( (char *)nl);
cursor=0;
}
prints("Warning: ");
prints( (char *)ermesg[err-1]); /* error message */
if(stocurlin)
prsline(_on_line_, stocurlin);
prints( (char *)nl);
}
/*
* This is executed by the ON ERROR construct it checks to see
* that we are not executing an error trap then set up the error
* trap pointer.
*/
void
errtrap()
{
register lpoint p;
register lnumb l;
l=getlin();
if(l == NOLNUMB)
error(SYNTAX);
check();
if(intrap)
error(8);
if(l == 0){
trap_env.e_stolin = 0;
return;
}
p = getsline(l);
trap_env.e_stolin = p;
trap_env.e_point = p->lin;
trap_env.e_ertrap = 0;
trap_env.e_elses = 0;
}
/*
* The 'resume' command , checks to see that we are actually
* executing an error trap. If there is an optional linenumber then
* we resume from there else we resume from where the error was.
*/
int
resume()
{
register lpoint p;
register lnumb i;
int c;
if(!intrap)
error(8);
c = getch();
if(c != NEXT){
point--;
i= getlin();
}
else
i = 0;
check();
if(i != NOLNUMB && i != 0){
p = getsline(i);
ret_env(&err_env);
stocurlin= p; /* resume at that line */
point= p->lin;
elsecount=0;
}
else {
ret_env(&err_env);
if(c == NEXT){
if( (p = stocurlin->next) == 0)
reset();
stocurlin= p; /* resume at next line */
point= p->lin;
elsecount=0;
}
}
intrap=0; /* get out of the trap */
return(-1); /* return to re-execute */
}
/*
* The 'error' command , this calls the error routine ( used in testing
* an error trapping routine.
*/
int
doerror()
{
register itype i;
i=evalint();
check();
if(i<1 || i >MAXERR)
error(22); /* illegal error code */
error( (int)i);
normret;
}
int
tron()
{
tron_flag = 1;
normret;
}
int
troff()
{
tron_flag = 0;
normret;
}
/*
* This routine is used to clear space for strings and to reset all
* other pointers so that it effectively clears the variables.
*/
void
clear()
{
/*
* reset the gosub stack, clear the stack before the symbol
* table, because of multiline functions and ncall
*/
clr_stack(savbstack);
clr_stack(bstack);
savestack = savbstack = bstack = estack = 0;
set_mem(tcharmap, (ival)TMAPSIZ, RVAL);
/*
* clear the variables
*/
clear_htab(&hshtab);
/*
* free any spare string blocks
*/
DROP_STRINGS();
#ifdef OWN_ALLOC
m_purge();
#endif
datastolin=0; /* reset the pointer to data */
datapoint=0; /* reset the pointer to data */
contpos=0;
#ifdef RAND48
srand48(1);
#else
srand(0); /* reset the random number */
/* generator */
#endif
}
/*
* free one entry
*/
void
free_entry(op)
register struct entry *op;
{
if(op->vtype == UNK_VAL){
mfree( (MEMP)op);
return;
}
if(op->dimens){
if(op->vtype == SVAL)
free_ar(op);
mfree( (MEMP)op->_darr);
}
else if(op->vtype & ISFUNC){
if(op->_deffn != 0)
mfree( (MEMP)op->_deffn);
}
else if(op->vtype == SVAL && !(op->flags & IS_FSTRING)){
if(op->_dstr != 0)
mfree( (MEMP)op->_dstr);
}
mfree( (MEMP)op);
}
static void
free_ar(op)
struct entry *op;
{
register int j = 1;
register stringp sp;
int i;
for(i = 0 ; i < op->dimens ; i++)
j *= op->_dims[i];
/*LINTED pointer conversion */
for(sp = (stringp)op->_darr ; j ; sp++, j--)
if(sp->str)
mfree( (MEMP)sp->str);
}
/* clear the hash table*/
void
clear_htab(htab)
struct hash *htab;
{
register struct entry **p, *op;
register int i = 0;
for(p = htab->hasht ; i < HSHTABSIZ ; i++, p++)
while( (op = *p) != 0){
*p = op->link;
free_entry(op);
}
}
void
clr_stack(sptr)
register forstp sptr;
{
register forstp np;
register struct entry *ep;
while(sptr){
if(sptr->fortyp == FNTYP){
ep = sptr->fnvar;
ep->_deffn->ncall--;
if(ep->vtype == SVAL && ep->_deffn->mline == IS_MFN){
if(sptr->fnsval.str != 0){
mfree( (MEMP)sptr->fnsval.str);
sptr->fnsval.str = 0;
}
}
if(sptr->fnLOCAL)
recover_vars(sptr, 1);
if(str_used)
FREE_STR(str_used);
str_used = sptr->fnSBEG;
str_uend = sptr->fnSEND;
}
np = sptr->next;
mfree( (MEMP)sptr);
sptr = np;
}
}
/*
* when closing a blocked file. zap all fstring variables.
* do this quickly by just resetting the bit and then setting their
* pointers to zero
*/
void
kill_fstrs(bstr, estr)
CHAR *bstr, *estr;
{
register struct entry **p, *op;
for(p = hshtab.hasht ; p < &hshtab.hasht[HSHTABSIZ]; p++)
for(op = *p ; op ; op = op->link)
if( (op->flags & IS_FSTRING) == 0)
continue;
else if(op->_dstr >= bstr && op->_dstr < estr){
op->flags &= ~IS_FSTRING;
op->_dstr = 0;
op->_dslen = 0;
}
}
/*
* drop all variables which are not common, only used in chain
*/
void
ch_clear(doall)
int doall;
{
struct hash tmphshtab;
struct entry **p, **q;
register struct entry *ep, **nep, **neq, *tep = 0;
q = tmphshtab.hasht;
for(p = hshtab.hasht ; p < &hshtab.hasht[HSHTABSIZ] ; p++, q++){
ep = *p;
neq = q;
nep = p;
for(*neq = *nep = 0 ; ep ; ep = tep){
tep = ep->link;
ep->link = 0;
if(!doall && (ep->flags & IS_COMMON) == 0){
*nep = ep;
nep = &ep->link;
}
else {
*neq = ep;
neq = &ep->link;
}
}
}
clear();
hshtab = tmphshtab;
}
void
add_entry(op)
register struct entry *op;
{
register int i;
i = MKhash(op->ln_hash);
op->link = hshtab.hasht[i];
hshtab.hasht[i] = op;
}
/*
* mtest() is used to set the amount of core for the current program
* it uses brk() to ask the system for more core.
* The core is allocated in 1K chunks, this is so that the program does
* not spend most of is time asking the system for more core and at the
* same time does not hog more core than is neccasary ( be friendly to
* the system ).
* Any test that is less than 'ecore' is though of as an error and
* so is any test greater than the size that seven memory management
* registers can handle.
* If there is this error then a test is done to see if 'ecore' can
* be accomodated. If so then that size is allocated and error() is called
* otherwise print a message and exit the interpreter.
* If the value of the call is less than 'ecore' we have a problem
* with the interpreter and we should cry for help. (It doesn't ).
*/
#ifdef __STDC__
void *
mmalloc(len)
ival len;
{
register void *p;
#ifndef OWN_ALLOC
#ifndef i386
extern void *malloc(unsigned int);
#endif
if( (p = malloc((unsigned int)len)) != 0)
return(p);
clear();
if( (p = malloc((unsigned int)len)) == 0){
prints("out of core\n"); /* print message */
VOID quit(); /* exit flushing buffers */
}
mfree( (MEMP)p);
#else
if( (p = m_get((unsigned int)len)) != 0)
return(p);
clear();
m_purge();
if( (p = m_get((unsigned int)len)) == 0){
prints("out of core\n"); /* print message */
VOID quit(); /* exit flushing buffers */
}
m_free( (void *)p);
#endif
error(24);
NO_RET; /* should never be reached */
}
void
mfree(mem)
MEMP mem;
{
#ifdef OWN_ALLOC
m_free( (void *)mem);
#else
free( (void *)mem);
#endif
}
int
mtestalloc(len)
ival len;
{
register void *p;
#ifndef OWN_ALLOC
#ifndef i386
extern void *malloc(unsigned int);
#endif
if( (p = malloc((unsigned int)len)) != 0){
mfree( (MEMP)p);
return(1);
}
#else
m_purge();
if( (p = m_get((unsigned int)len)) != 0){
m_free(p);
return(1);
}
#endif
return(0);
}
#else
memp
mmalloc(len)
ival len;
{
register memp p;
#ifndef OWN_ALLOC
char *malloc();
p = (memp)malloc((unsigned int)len);
if(p != 0)
return(p);
clear();
if( (p = (memp)malloc((unsigned int)len)) == 0){
prints("out of core\n"); /* print message */
VOID quit(); /* exit flushing buffers */
}
mfree(p);
#else
if( (p = m_get((unsigned int)len)) != 0)
return(p);
clear();
m_purge();
if( (p = m_get((unsigned int)len)) == 0){
prints("out of core\n"); /* print message */
VOID quit(); /* exit flushing buffers */
}
m_free( (MEMP)p);
#endif
error(24);
NO_RET; /* should never be reached */
}
void
mfree(mem)
MEMP mem;
{
#ifdef OWN_ALLOC
m_free( (void *)mem);
#else
free(mem);
#endif
}
int
mtestalloc(len)
ival len;
{
register memp p;
#ifndef OWN_ALLOC
char *malloc();
p = (memp)malloc((unsigned int)len);
if(p != 0){
mfree(p);
return(1);
}
#else
m_purge();
if( (p = m_get((unsigned int)len)) != 0){
m_free(p);
return(1);
}
#endif
return(0);
}
#endif
/*
* This routine tries to set up the system to catch all the signals that
* can be produced. (except kill ). and do something sensible if it
* gets one. ( There is no way of producing a core image through the
* sending of signals).
*/
#ifndef MSDOS
#ifdef __STDC__
/*ARGSUSED*/
static SIGFUNC squit(int x) { VOID quit(); }
static SIGFUNC sexit(int x) { _exit(x); }
#else
static SIGFUNC squit() { VOID quit(); }
static SIGFUNC sexit() { _exit(1); }
#endif
#endif
static const struct mysigs {
int sigval;
#ifdef __STDC__
SIGFUNC (*sigfunc)(int);
#else
SIGFUNC (*sigfunc)();
#endif
} traps[] = {
#ifndef MSDOS
SIGHUP, squit, /* hang up */
#endif
SIGINT, trap,
#ifndef MSDOS
SIGQUIT, quit1,
SIGILL, sexit,
SIGTRAP, sexit,
SIGIOT, sexit,
#ifdef SIGEMT
SIGEMT, sexit,
#endif
SIGFPE, catchfp, /* fp exception */
/* SIGKILL, 0, / * kill */
SIGBUS, seger, /* seg err */
SIGSEGV, mcore, /* bus err */
/* SIGSYS, 0, */
SIGPIPE, sexit,
SIGALRM, squit,
SIGTERM, sexit,
SIGUSR1, sexit,
#ifdef SIGUSR2
SIGUSR2, sexit,
#endif
#ifdef SIGTSTP
SIGTSTP, onstop,
#endif
#endif
};
void
catchsignal()
{
register const struct mysigs *sp;
for(sp = traps ; sp < &traps[sizeof(traps) / sizeof(traps[0])]; sp++)
if(sp->sigval)
VOID signal(sp->sigval, sp->sigfunc);
}
/*
* this routine deals with floating exceptions via fpfunc
* this is a function pointer set up in fpstart so that trapping
* can be done for floating point exceptions.
*/
/*ARGSUSED*/
static SIGFUNC
catchfp(x)
int x;
{
#ifndef MSDOS
VOID signal(SIGFPE,catchfp); /* restart catching */
#endif
if(fpfunc== 0) /* this is set up in fpstart() */
_exit(1);
(*fpfunc)();
}
/*
* we have a segmentation violation and so should print the message and
* exit. Either a kill() from another process or an interpreter bug.
*/
/*ARGSUSED*/
static SIGFUNC
seger(x)
int x;
{
prints("segmentation violation\n");
_exit(-1);
/*NOTREACHED*/
}
/*
* This does the same for bus errors as seger() does for segmentation
* violations. The interpreter is pretty nieve about the execution
* of complex expressions and should really check the stack every time,
* to see if there is space left. This is an easy error to fix, but
* it was not though worthwhile at the moment. If it runs out of stack
* space then there is a vain attempt to call mcore() that fails and
* so which produces another bus error and a core image.
*/
/*ARGSUSED*/
static SIGFUNC
mcore(x)
int x;
{
prints("bus error\n");
_exit(-1);
/*NOTREACHED*/
}
/*
* Called by the cntrl-c signal (number 2 ). It sets 'trapped' to
* signify that there has been a cntrl-c and then re-enables the trap.
* It also bleeps at you.
*/
/*ARGSUSED*/
static SIGFUNC
trap(x)
int x;
{
VOID signal(SIGINT, SIG_IGN);/* ignore signal for the bleep */
VOID write(1, "\07", 1); /* bleep */
VOID signal(SIGINT, trap); /* re-enable the trap */
trapped=1; /* say we have had a cntrl-c */
#ifdef SIG_JMP
if(ecalling){
ecalling = 0;
longjmp(ecall, 1);
/*NOTREACHED*/
}
#endif
}
/*
* called by cntrl-\ trap , It prints the message and then exits
* via quit() so flushing the buffers, and getting the terminal back
* in a sensible mode.
*/
/*ARGSUSED*/
static SIGFUNC
quit1(x)
int x;
{
#ifndef MSDOS
VOID signal(SIGQUIT,SIG_IGN);/* ignore any more */
#endif
if(cursor){ /* put cursor on a new line */
prints( (char *)nl);
cursor=0;
}
prints("quit\n\r"); /* print the message */
VOID quit(); /* exit */
}
/*
* resets the terminal , flushes all files then exits
* this is the standard route exit from the interpreter. The seger()
* and mcore() traps should not go through these traps since it could
* be the access to the files that is causing the error and so this
* would produce a core image.
* From this it may be gleened that I don't like core images.
*/
int
quit()
{
flushall(); /* flush the files */
rset_term(1);
if(cursor)
prints( (char *)nl);
exit(0); /* goodbye */
normret;
}
static void
docont()
{
if(stocurlin){
contpos=0;
clr_stack(savbstack);
if(cancont){
savestack = estack;
savbstack = bstack;
bstack = estack = 0;
contpos=cancont;
}
else
savbstack = savestack = 0;
}
cancont=0;
}
#ifdef SIGTSTP
#ifdef __STDC__
#if __STDC__ != 0
extern int kill(pid_t, int);
#endif
#endif
/*
* support added for job control
*/
/*ARGSUSED*/
static SIGFUNC
onstop(x)
int x;
{
flushall(); /* flush the files */
rset_term(1);
if(cursor){
prints( (char *)nl);
cursor = 0;
}
#ifdef SIG_JMP
VOID sigsetmask(0); /* Urgh !!!!!! */
#endif
VOID signal(SIGTSTP, SIG_DFL);
VOID kill(0,SIGTSTP);
/* The PC stops here */
VOID signal(SIGTSTP,onstop);
}
#endif
syntax highlighted by Code2HTML, v. 0.9.1