/* pname - parse a symbol/package name */
LOCAL int pname(LVAL fptr,int *pescflag)
{
int mode,ch,i;
LVAL type;
/* initialize */
*pescflag = FALSE;
mode = NORMAL;
i = 0;
/* accumulate the symbol name */
while (mode != DONE) {
/* handle normal mode */
while (mode == NORMAL)
if ((ch = xlgetc(fptr)) == EOF)
mode = DONE;
else if ((type = tentry(ch)) == k_sescape) {
i = storech(buf,i,checkeof(fptr));
*pescflag = TRUE;
}
else if (type == k_mescape) {
*pescflag = TRUE;
mode = ESCAPE;
}
else if (type == k_const
|| (consp(type) && car(type) == k_nmacro))
i = storech(buf,i,islower(ch) ? toupper(ch) : ch);
else
mode = DONE;
/* handle multiple escape mode */
while (mode == ESCAPE)
if ((ch = xlgetc(fptr)) == EOF)
badeof(fptr);
else if ((type = tentry(ch)) == k_sescape)
i = storech(buf,i,checkeof(fptr));
else if (type == k_mescape)
mode = NORMAL;
else
i = storech(buf,i,ch);
}
buf[i] = 0;
/* check for a zero length name */
if (i == 0)
xlerror("zero length name", s_unbound);
/* unget the last character and return it */
xlungetc(fptr,ch);
return (ch);
}
Static Stmt *proc_freadbytes()
{
Expr *ex, *ex2, *vex, *fex;
Type *type;
if (!skipopenparen())
return NULL;
fex = p_expr(tp_text);
if (!skipcomma())
return NULL;
vex = p_expr(NULL);
if (!skipcomma())
return NULL;
ex2 = p_expr(tp_integer);
skipcloseparen();
type = vex->val.type;
ex = makeexpr_bicall_4("fread", tp_integer,
makeexpr_addr(vex),
convert_size(type, ex2, "FREADBYTES"),
makeexpr_long(1),
filebasename(copyexpr(fex)));
if (checkeof(fex)) {
ex = makeexpr_bicall_2(name_SETIO, tp_void,
makeexpr_rel(EK_EQ, ex, makeexpr_long(1)),
makeexpr_long(30));
}
return wrapopencheck(makestmt_call(ex), fex);
}
/* rmdquote - read macro for '"' */
LVAL rmdquote(void)
{
unsigned char buf[STRMAX+1],*p,*sptr;
LVAL fptr,str,newstr,mch;
int len,blen,ch,d2,d3;
/* protect some pointers */
xlsave1(str);
/* get the file and macro character */
fptr = xlgetfile();
mch = xlgachar();
xllastarg();
/* loop looking for a closing quote */
len = blen = 0; p = buf;
while ((ch = checkeof(fptr)) != '"') {
/* handle escaped characters */
switch (ch) {
case '\\':
switch (ch = checkeof(fptr)) {
case 't':
ch = '\011';
break;
case 'n':
ch = '\012';
break;
case 'f':
ch = '\014';
break;
case 'r':
ch = '\015';
break;
default:
if (ch >= '0' && ch <= '7') {
d2 = checkeof(fptr);
d3 = checkeof(fptr);
if (d2 < '0' || d2 > '7'
|| d3 < '0' || d3 > '7')
xlfail("invalid octal digit");
ch -= '0'; d2 -= '0'; d3 -= '0';
ch = (ch << 6) | (d2 << 3) | d3;
}
break;
}
}
/* check for buffer overflow */
if (blen >= STRMAX) {
newstr = new_string(len + STRMAX + 1);
sptr = getstring(newstr); *sptr = '\0';
if (str) strcat((char *) sptr, (char *) getstring(str));
*p = '\0'; strcat((char *) sptr, (char *) buf);
p = buf; blen = 0;
len += STRMAX;
str = newstr;
}
/* store the character */
*p++ = ch; ++blen;
}
/* append the last substring */
if (str == NIL || blen) {
newstr = new_string(len + blen + 1);
sptr = getstring(newstr); *sptr = '\0';
if (str) strcat((char *) sptr, (char *) getstring(str));
*p = '\0'; strcat((char *) sptr, (char *) buf);
str = newstr;
}
/* restore the stack */
xlpop();
/* return the new string */
return (consa(str));
}
