home *** CD-ROM | disk | FTP | other *** search
- /* PostScript interpreter file "postop2.c" - operators (2)
- * (C) Adrian Aylward 1989, 1992
- * V1.6 First source release
- * V1.7 Fix roll of zero items
- */
-
- # include "post.h"
-
- /* index */
-
- void opindex(void)
- { struct object *token1;
- int num;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- if (token1->type != typeint) error(errtypecheck);
- num = token1->value.ival;
- if (num < 0 || num > opernest - 2) error(errrangecheck);
- *token1 = *(token1 - num - 1);
- }
-
- /* known */
-
- void opknown(void)
- { struct object token, *token1, *token2;
- int bool;
- if (opernest < 2) error(errstackunderflow);
- token2 = &operstack[opernest - 1];
- token1 = token2 - 1;
- if (token1->type != typedict) error(errtypecheck);
- bool = dictget(token1->value.vref, token2, &token, flagrprot);
- token.type = typebool;
- token.flags = 0;
- token.length = 0;
- token.value.ival = bool;
- *token1 = token;
- opernest -= 1;
- }
-
- /* le */
-
- void ople(void)
- { struct object token, *token1, *token2;
- if (opernest < 2) error(errstackunderflow);
- token2 = &operstack[opernest - 1];
- token1 = token2 - 1;
- token.type = typebool;
- token.flags = 0;
- token.length = 0;
- token.value.ival = (compare(token1, token2) <= 0);
- *token1 = token;
- opernest--;
- }
-
- /* length */
-
- void oplength(void)
- { struct object token, *token1;
- struct dictionary *dict;
- struct name *name;
- int length;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- if (token1->type == typearray || token1->type == typepacked ||
- token1->type == typestring)
- { if (token1->flags & flagrprot) error(errinvalidaccess);
- length = token1->length;
- }
- else if (token1->type == typedict)
- { dict = vmdptr(token1->value.vref);
- if (dict->flags & flagrprot) error(errinvalidaccess);
- length = dict->full;
- }
- else if (token1->type == typename)
- { name = vmnptr(token1->value.vref);
- length = name->length;
- }
- else
- error(errtypecheck);
- token.type = typeint;
- token.flags = 0;
- token.length = 0;
- token.value.ival = length;
- *token1 = token;
- }
-
- /* ln */
-
- void opln(void)
- { struct object token, *token1;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- token = *token1;
- if (token.type == typeint)
- { token.type = typereal;
- token.value.rval = token.value.ival;
- }
- if (token.type == typereal)
- token.value.rval = (float) log((double) token.value.rval);
- else
- error(errtypecheck);
- *token1 = token;
- }
-
- /* load */
-
- void opload(void)
- { struct object *token;
- if (opernest < 1) error(errstackunderflow);
- token = &operstack[opernest - 1];
- if (dictfind(token, token) == -1) error(errundefined);
- }
-
- /* log */
-
- void oplog(void)
- { struct object token, *token1;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- token = *token1;
- if (token.type == typeint)
- { token.type = typereal;
- token.value.rval = token.value.ival;
- }
- if (token.type == typereal)
- token.value.rval = (float) log10((double) token.value.rval);
- else
- error(errtypecheck);
- *token1 = token;
- }
-
- /* loop */
-
- void oploop(void)
- { struct object token, *token1, *tokenx;
- if (currtoken->flags & flagctrl)
- { token1 = &execstack[execnest - 2];
- token1[2] = *token1;
- execnest++;
- }
- else
- { if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- if (token1->type != typearray && token1->type != typepacked)
- error(errtypecheck);
- if (execnest + 3 > execstacksize) error(errexecstackoverflow);
- tokenx = &execstack[execnest];
- *tokenx++ = *token1;
- token = *currtoken;
- token.flags &= ~flagexec;
- token.flags |= flagctrl | flagloop;
- token.length = 2;
- *tokenx = token;
- execnest += 2;
- opernest -= 1;
- }
- }
-
- /* lt */
-
- void oplt(void)
- { struct object token, *token1, *token2;
- if (opernest < 2) error(errstackunderflow);
- token2 = &operstack[opernest - 1];
- token1 = token2 - 1;
- token.type = typebool;
- token.flags = 0;
- token.length = 0;
- token.value.ival = (compare(token1, token2) < 0);
- *token1 = token;
- opernest--;
- }
-
- /* maxlength */
-
- void opmaxlength(void)
- { struct object token, *token1;
- struct dictionary *dict;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- if (token1->type != typedict) error(errtypecheck);
- dict = vmdptr(token1->value.vref);
- if (dict->flags & flagrprot) error(errinvalidaccess);
- token.type = typeint;
- token.flags = 0;
- token.length = 0;
- token.value.ival = dict->size;
- *token1 = token;
- }
-
- /* mod */
-
- void opmod(void)
- { struct object *token1, *token2;
- int num1, num2;
- if (opernest < 2) error(errstackunderflow);
- token2 = &operstack[opernest - 1];
- token1 = token2 - 1;
- if (token1->type != typeint || token2->type != typeint)
- error(errtypecheck);
- num1 = token1->value.ival;
- num2 = token2->value.ival;
- if (num2 == 0) error(errundefinedresult);
- token1->value.ival = num1 % num2;
- opernest--;
- }
-
- /* mul */
-
- void opmul(void)
- { struct object token, *token1, *token2;
- int num1, num2, tmp1, tmp2;
- unsigned int neg;
- if (opernest < 2) error(errstackunderflow);
- token2 = &operstack[opernest - 1];
- token1 = token2 - 1;
- if (token1->type == typeint && token2->type == typeint)
- { num1 = token1->value.ival;
- num2 = token2->value.ival;
- neg = 0x7fffffff;
- if (num1 < 0)
- { neg = ~neg;
- num1 = -num1;
- }
- if (num2 < 0)
- { neg = ~neg;
- num2 = -num2;
- }
- tmp1 = (unsigned) num1 >> 16;
- tmp2 = (unsigned) num2 >> 16;
- num1 &= 0xffff;
- num2 &= 0xffff;
- if (tmp1 == 0)
- { if (tmp2 == 0)
- { num1 *= num2;
- if ((unsigned) num1 <= neg)
- { token1->value.ival = (neg == 0x7fffffff) ? num1 : -num1;
- opernest--;
- return;
- }
- }
- else
- { tmp2 *= num1;
- num1 *= num2;
- tmp1 = tmp2 + ((unsigned) num1 >> 16);
- num1 += tmp2 << 16;
- if ((tmp1 & 0xffff0000) == 0 && (unsigned) num1 <= neg)
- { token1->value.ival = (neg == 0x7fffffff) ? num1 : -num1;
- opernest--;
- return;
- }
- }
- }
- else
- if (tmp2 == 0)
- { tmp1 *= num2;
- num2 *= num1;
- tmp2 = tmp1 + ((unsigned) num2 >> 16);
- num2 += tmp1 << 16;
- if ((tmp2 & 0xffff0000) == 0 && (unsigned) num2 <= neg)
- { token1->value.ival = (neg == 0x7fffffff) ? num2 : -num2;
- opernest--;
- return;
- }
- }
-
- }
- token = *token1;
- if (token.type == typeint)
- { token.type = typereal;
- token.value.rval = token.value.ival;
- }
- else
- if (token.type != typereal) error(errtypecheck);
- if (token2->type == typeint)
- token.value.rval *= token2->value.ival;
- else
- { if (token2->type != typereal) error(errtypecheck);
- token.value.rval *= token2->value.rval;
- }
- *token1 = token;
- opernest--;
- }
-
- /* ne */
-
- void opne(void)
- { struct object token, *token1, *token2;
- if (opernest < 2) error(errstackunderflow);
- token2 = &operstack[opernest - 1];
- token1 = token2 - 1;
- token.type = typebool;
- token.flags = 0;
- token.length = 0;
- token.value.ival = !equal(token1, token2);
- *token1 = token;
- opernest--;
- }
-
- /* neg */
-
- void opneg(void)
- { struct object *token1;
- int num1;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- if (token1->type == typeint)
- { num1 = token1->value.ival;
- if (num1 < 0)
- { num1 = -num1;
- if (num1 < 0)
- { token1->type = typereal;
- token1->value.rval = -((float) num1);
- }
- else
- token1->value.ival = num1;
- }
- else
- token1->value.ival = -num1;
- }
- else if (token1->type == typereal)
- token1->value.rval = -token1->value.rval;
- else
- error(errtypecheck);
- }
-
- /* noaccess */
-
- void opnoaccess(void)
- { struct object *token1;
- int type;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- type = token1->type;
- if (type == typefile || type == typestring ||
- type == typearray || type == typepacked)
- token1->flags |= (flagwprot | flagrprot | flagxprot);
- else if (type == typedict)
- vmdptr(token1->value.vref)->flags |= (flagwprot | flagrprot);
- else
- error(errtypecheck);
- }
-
- /* not */
-
- void opnot(void)
- { struct object *token1;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- if (token1->type == typebool)
- token1->value.ival = !token1->value.ival;
- else if (token1->type == typeint)
- token1->value.ival = ~token1->value.ival;
- else
- error(errtypecheck);
- }
-
- /* null */
-
- void opnull(void)
- { struct object token;
- if (opernest == operstacksize) error(errstackoverflow);
- token.type = typenull;
- token.flags = 0;
- token.length = 0;
- token.value.ival = 0;
- operstack[opernest++] = token;
- }
-
- /* or */
-
- void opor(void)
- { struct object *token1, *token2;
- if (opernest < 2) error(errstackunderflow);
- token2 = &operstack[opernest - 1];
- token1 = token2 - 1;
- if ((token1->type == typebool && token2->type == typebool) ||
- (token1->type == typeint && token2->type == typeint))
- token1->value.ival |= token2->value.ival;
- else
- error(errtypecheck);
- opernest--;
- }
-
- /* packedarray */
-
- void oppackedarray(void)
- { struct object token, *token1, *aptr;
- int length;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- if (token1->type != typeint) error(errtypecheck);
- length = token1->value.ival;
- if (length < 0) error(errrangecheck);
- if (opernest < length + 1) error(errstackunderflow);
- aptr = token1 - length;
- token.type = typepacked;
- token.flags = flagwprot;
- token.length = length;
- token.value.vref = arraypack(aptr, length);
- *aptr = token;
- opernest -= length;
- }
-
- /* pop */
-
- void oppop(void)
- { if (opernest < 1) error(errstackunderflow);
- opernest -= 1;
- }
-
- /* print */
-
- void opprint(void)
- { struct object *token1;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- if (token1->type != typestring) error(errtypecheck);
- if (token1->flags & flagrprot) error(errinvalidaccess);
- if (sstdout)
- putmem(sstdout, vmsptr(token1->value.vref), token1->length);
- opernest--;
- }
-
- /* prompts */
-
- void opprompts(void)
- { struct object *token1, *token2;
- if (opernest < 2) error(errstackunderflow);
- token2 = &operstack[opernest - 1];
- token1 = token2 - 1;
- if (token1->type != typestring) error(errtypecheck);
- if (token1->flags & flagrprot) error(errinvalidaccess);
- if (token1->length > promptsize) error(errrangecheck);
- if (token2->type != typestring) error(errtypecheck);
- if (token2->flags & flagrprot) error(errinvalidaccess);
- if (token2->length > promptsize) error(errrangecheck);
- memcpy(prompt1, vmsptr(token1->value.vref), token1->length);
- prompt1[token1->length] = 0;
- memcpy(prompt2, vmsptr(token2->value.vref), token2->length);
- prompt2[token2->length] = 0;
- opernest -= 2;
- }
-
- /* pstack */
-
- void oppstack(void)
- { int nest = opernest;
- if (sstdout)
- while (nest)
- { printeqeq(sstdout, &operstack[--nest], 0, 0);
- putch(sstdout, '\n');
- }
- }
-
- /* put */
-
- void opput(void)
- { struct object *token1, *token2, *token3;
- int num;
- if (opernest < 3) error(errstackunderflow);
- token3 = &operstack[opernest - 1];
- token2 = token3 - 1;
- token1 = token2 - 1;
- if (token1->type == typedict)
- dictput(token1->value.vref, token2, token3);
- else
- { if (token2->type != typeint) error(errtypecheck);
- num = token2->value.ival;
- if (token1->type == typestring)
- { if (token3->type != typeint) error(errtypecheck);
- if (token1->flags & flagwprot) error(errinvalidaccess);
- if (num < 0 || num >= token1->length) error(errrangecheck);
- vmsptr(token1->value.vref)[num] = token3->value.ival;
- }
- else if (token1->type == typearray)
- { if (token1->flags & flagwprot) error(errinvalidaccess);
- if (num < 0 || num >= token1->length) error(errrangecheck);
- arraysave(token1->value.vref, token1->length);
- vmaptr(token1->value.vref)[num] = *token3;
- }
- else
- error(errtypecheck);
- }
- opernest -= 3;
- }
-
- /* putinterval */
-
- void opputinterval(void)
- { struct object *token1, *token2, *token3;
- int num, len;
- if (opernest < 3) error(errstackunderflow);
- token3 = &operstack[opernest - 1];
- token2 = token3 - 1;
- token1 = token2 - 1;
- if (token2->type != typeint) error(errtypecheck);
- num = token2->value.ival;
- if (token3->type != token1->type) error(errtypecheck);
- len = token3->length;
- if (token1->type == typestring)
- { if (token1->flags & flagwprot) error(errinvalidaccess);
- if (token3->flags & flagrprot) error(errinvalidaccess);
- if (num < 0 || num > token1->length) error(errrangecheck);
- if (len < 0 || num + len > token1->length) error(errrangecheck);
- memcpy(vmsptr(token1->value.vref) + num,
- vmsptr(token3->value.vref), len);
- }
- else if (token1->type == typearray)
- { if (token1->flags & flagwprot) error(errinvalidaccess);
- if (token3->flags & flagrprot) error(errinvalidaccess);
- if (num < 0 || num > token1->length) error(errrangecheck);
- if (len < 0 || num + len > token1->length) error(errrangecheck);
- arraysave(token1->value.vref, token1->length);
- arraycopy(vmaptr(token1->value.vref) + num,
- vmaptr(token3->value.vref), len);
- }
- else
- error(errtypecheck);
- opernest -= 3;
- }
-
- /* quit */
-
- void opquit(void)
- { execnest = 0;
- errorjmp(0, 1);
- }
-
- /* rand */
-
- void oprand(void)
- { struct object token;
- if (opernest == operstacksize) error(errstackoverflow);
- random *= 0x41c64e6d;
- random += 0x3039;
- token.type = typeint;
- token.flags = 0;
- token.length = 0;
- token.value.ival = random >> 1;
- operstack[opernest++] = token;
- }
-
- /* rcheck */
-
- void oprcheck(void)
- { struct object token, *token1;
- int type, bool;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- type = token1->type;
- if (type == typefile || type == typestring ||
- type == typearray || type == typepacked)
- bool = ((token1->flags & flagrprot) == 0);
- else if (type == typedict)
- bool = ((vmdptr(token1->value.vref)->flags & flagrprot) == 0);
- else
- error(errtypecheck);
- token.type = typebool;
- token.flags = 0;
- token.length = 0;
- token.value.ival = bool;
- *token1 = token;
- }
-
- /* read */
-
- void opread(void)
- { struct object token, *token1;
- int ch;
- if (opernest < 1) error(errstackunderflow);
- if (opernest == operstacksize) error(errstackoverflow);
- token1 = &operstack[opernest - 1];
- if (token1->type != typefile) error(errtypecheck);
- if (token1->flags & flagrprot) error(errinvalidaccess);
- if (filecheck(token1, openread) == NULL) error(errioerror);
- ch = readch(token1, -2);
- token.flags = 0;
- token.length = 0;
- if (ch == EOF)
- { fileclose(token1);
- token.value.ival = 0;
- }
- else
- { token.type = typeint;
- token.value.ival = ch;
- *token1++ = token;
- token.value.ival = 1;
- opernest++;
- }
- token.type = typebool;
- *token1 = token;
- }
-
- /* readhexstring */
-
- void opreadhexstring(void)
- { struct object token, *token1, *token2;
- char *sptr;
- int ch, length, num, dig, sw;
- if (opernest < 2) error(errstackunderflow);
- token2 = &operstack[opernest - 1];
- token1 = token2 - 1;
- if (token1->type != typefile) error(errtypecheck);
- if (token1->flags & flagrprot) error(errinvalidaccess);
- if (filecheck(token1, openread) == NULL) error(errioerror);
- if (token2->type != typestring) error(errtypecheck);
- if (token2->flags & flagwprot) error(errinvalidaccess);
- length = 0;
- sptr = vmsptr(token2->value.vref);
- ch = 0;
- sw = 1;
- while (length < token2->length)
- { ch = readch(token1, -1);
- if (ch == EOF) break;
- dig = digitval(ch);
- if (dig >= 16) continue;
- if (sw)
- { sw = 0;
- num = dig * 16;
- }
- else
- { sw = 1;
- num += dig;
- *sptr++ = num;
- length++;
- }
- }
- token = *token2;
- token.length = length;
- *token1 = token;
- token.type = typebool;
- token.flags = 0;
- token.length = 0;
- token.value.ival = (ch != EOF);
- *token2 = token;
- }
-
- /* readline */
-
- void opreadline(void)
- { struct object token, *token1, *token2;
- char *sptr;
- int ch, length;
- if (opernest < 2) error(errstackunderflow);
- token2 = &operstack[opernest - 1];
- token1 = token2 - 1;
- if (token1->type != typefile) error(errtypecheck);
- if (token1->flags & flagrprot) error(errinvalidaccess);
- if (filecheck(token1, openread) == NULL) error(errioerror);
- if (token2->type != typestring) error(errtypecheck);
- if (token2->flags & flagwprot) error(errinvalidaccess);
- length = 0;
- sptr = vmsptr(token2->value.vref);
- ch = 0;
- for (;;)
- { ch = readch(token1, -1);
- if (ch == '\n' || ch == EOF) break;
- if (length == token2->length) error(errrangecheck);
- *sptr++ = ch;
- length++;
- }
- token = *token2;
- token.length = length;
- *token1 = token;
- token.type = typebool;
- token.flags = 0;
- token.length = 0;
- token.value.ival = (ch != EOF);
- *token2 = token;
- }
-
- /* readonly */
-
- void opreadonly(void)
- { struct object *token1;
- struct dictionary *dict;
- int type;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- type = token1->type;
- if (type == typefile || type == typestring ||
- type == typearray || type == typepacked)
- { if (token1->flags & flagrprot) error(errinvalidaccess);
- token1->flags |= flagwprot;
- }
- else if (type == typedict)
- { dict = vmdptr(token1->value.vref);
- if (dict->flags & flagrprot) error(errinvalidaccess);
- dict->flags |= flagwprot;
- }
- else
- error(errtypecheck);
- }
-
- /* readstring */
-
- void opreadstring(void)
- { struct object token, *token1, *token2;
- char *sptr;
- int ch, length;
- if (opernest < 2) error(errstackunderflow);
- token2 = &operstack[opernest - 1];
- token1 = token2 - 1;
- if (token1->type != typefile) error(errtypecheck);
- if (token1->flags & flagrprot) error(errinvalidaccess);
- if (filecheck(token1, openread) == NULL) error(errioerror);
- if (token2->type != typestring) error(errtypecheck);
- if (token2->flags & flagwprot) error(errinvalidaccess);
- length = 0;
- sptr = vmsptr(token2->value.vref);
- ch = 0;
- while (length < token2->length)
- { ch = readch(token1, -2);
- if (ch == EOF) break;
- *sptr++ = ch;
- length++;
- }
- token = *token2;
- token.length = length;
- *token1 = token;
- token.type = typebool;
- token.flags = 0;
- token.length = 0;
- token.value.ival = (ch != EOF);
- *token2 = token;
- }
-
- /* repeat */
-
- void oprepeat(void)
- { struct object token, *token1, *token2, *tokenx;
- if (currtoken->flags & flagctrl)
- { token2 = &execstack[execnest - 2];
- token1 = token2 - 1;
- if (token1->value.ival <= 0)
- { execnest -= 3;
- return;
- }
- token1->value.ival--;
- token2[2] = *token2;
- execnest++;
- }
- else
- { if (opernest < 2) error(errstackunderflow);
- token2 = &operstack[opernest - 1];
- token1 = token2 - 1;
- if (token1->type != typeint) error(errtypecheck);
- if (token2->type != typearray && token2->type != typepacked)
- error(errtypecheck);
- if (execnest + 4 > execstacksize) error(errexecstackoverflow);
- tokenx = &execstack[execnest];
- *tokenx++ = *token1;
- *tokenx++ = *token2;
- token = *currtoken;
- token.flags &= ~flagexec;
- token.flags |= flagctrl | flagloop;
- token.length = 3;
- *tokenx = token;
- execnest += 3;
- opernest -= 2;
- }
- }
-
- /* resetfile */
-
- void opresetfile(void)
- { struct object *token1;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- if (token1->type != typefile) error(errtypecheck);
- if (filecheck(token1, openread | openwrite) == NULL) error(errioerror);
- opernest--;
- }
-
- /* restore */
-
- void oprestore(void)
- { struct object *token1;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- if (token1->type != typesave) error(errtypecheck);
- vmrest(token1->length, token1->value.ival);
- opernest--;
- }
-
- /* roll */
-
- void oproll(void)
- { struct object *token1, *token2;
- int num, dir, shf;
- if (opernest < 2) error(errstackunderflow);
- token2 = &operstack[opernest - 1];
- token1 = token2 - 1;
- if (token1->type != typeint) error(errtypecheck);
- num = token1->value.ival;
- if (token2->type != typeint) error(errtypecheck);
- dir = token2->value.ival;
- if (num < 0 || num > opernest - 2) error(errrangecheck);
- if (num != 0)
- { dir = dir % num;
- shf = num - dir;
- if (opernest + shf - 2 > operstacksize) error(errstackoverflow);
- arraycopy(token1, token1 - num, shf);
- arraycopy(token1 - num, token1 - dir, num);
- }
- opernest -= 2;
- }
-
- /* round */
-
- void opround(void)
- { struct object *token1;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- if (token1->type == typeint)
- return;
- else if (token1->type == typereal)
- token1->value.rval = (float) floor((double) token1->value.rval + .5);
- else
- error(errtypecheck);
- }
-
- /* rrand */
-
- void oprrand(void)
- { struct object token;
- if (opernest == operstacksize) error(errstackoverflow);
- token.type = typeint;
- token.flags = 0;
- token.length = 0;
- token.value.ival = random;
- operstack[opernest++] = token;
- }
-
- /* run */
-
- void oprun(void)
- { struct object token, *token1, *tokenx;
- if (currtoken->flags & flagctrl)
- execnest -= 2;
- else
- { if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- if (token1->type != typestring) error(errtypecheck);
- if (token1->flags & flagrprot) error(errinvalidaccess);
- if (execnest + 3 > execstacksize) error(errexecstackoverflow);
- tokenx = &execstack[execnest];
- fileopen(&token, openread, vmsptr(token1->value.vref),
- token1->length);
- token.flags |= flagexec;
- tokenx[0] = token;
- tokenx[2] = token;
- token = *currtoken;
- token.flags &= ~flagexec;
- token.flags |= flagctrl | flagrun;
- token.length = 2;
- tokenx[1] = token;
- execnest += 3;
- opernest--;
- }
- }
-
- /* save */
-
- void opsave(void)
- { struct object token;
- if (opernest == operstacksize) error(errstackoverflow);
- vmsave(&token);
- operstack[opernest++] = token;
- }
-
- /* search */
-
- void opsearch(void)
- { struct object *token1, *token2;
- char *sptr1, *sptr2;
- int len1, len2, offs, bool;
- struct object token;
- if (opernest < 2) error(errstackunderflow);
- if (opernest + 2 > operstacksize) error(errstackoverflow);
- token2 = &operstack[opernest - 1];
- token1 = token2 - 1;
- if (token1->type != typestring) error(errtypecheck);
- if (token1->flags & flagrprot) error(errinvalidaccess);
- len1 = token1->length;
- sptr1 = vmsptr(token1->value.vref);
- if (token2->type != typestring) error(errtypecheck);
- if (token2->flags & flagrprot) error(errinvalidaccess);
- len2 = token2->length;
- sptr2 = vmsptr(token2->value.vref);
- offs = 0;
- bool = 0;
- while (offs + len2 <= len1)
- { if (memcmp(sptr1 + offs, sptr2, len2) == 0)
- { bool = 1;
- break;
- }
- offs++;
- }
- if (bool)
- { token = *token1;
- token.length = offs;
- *(token2 + 1) = token;
- token.length = len2;
- token.value.vref = token1->value.vref + offs;
- *token2 = token;
- token.length = len1 - offs - len2;
- token.value.vref = token1->value.vref + offs + len2;
- *token1 = token;
- token2 += 2;
- opernest += 2;
- }
- token.type = typebool;
- token.flags = 0;
- token.length = 0;
- token.value.ival = bool;
- *token2 = token;
- }
-
- /* setpacking */
-
- void opsetpacking(void)
- { struct object *token1;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- if (token1->type != typebool) error(errtypecheck);
- packing = token1->value.ival;
- opernest--;
- }
-
- /* sin */
-
- void opsin(void)
- { struct object token, *token1;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- token = *token1;
- if (token.type == typeint)
- { token.type = typereal;
- token.value.rval = token.value.ival;
- }
- if (token.type == typereal)
- token.value.rval = (float) sin((double) token.value.rval * degtorad);
- else
- error(errtypecheck);
- *token1 = token;
- }
-
- /* sqrt */
-
- void opsqrt(void)
- { struct object token, *token1;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- token = *token1;
- if (token.type == typeint)
- { token.type = typereal;
- token.value.rval = token.value.ival;
- }
- if (token.type == typereal)
- { if (token.value.rval < 0.0) error(errrangecheck);
- token.value.rval = (float) sqrt((double) token.value.rval);
- }
- else
- error(errtypecheck);
- *token1 = token;
- }
-
- /* srand */
-
- void opsrand(void)
- { struct object *token1;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- if (token1->type != typeint) error(errrangecheck);
- random = token1->value.ival;
- opernest--;
- }
-
- /* stack */
-
- void opstack(void)
- { int nest = opernest;
- if (sstdout)
- while (nest)
- { printequals(sstdout, &operstack[--nest]);
- putch(sstdout, '\n');
- }
- }
-
- /* status */
-
- void opstatus(void)
- { struct object token, *token1;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- if (token1->type != typefile) error(errtypecheck);
- token.type = typebool;
- token.flags = 0;
- token.length = 0;
- token.value.ival =
- (filecheck(token1, openread | openwrite) != NULL);
- *token1 = token;
- }
-
- /* stop */
-
- void opstop(void)
- { stop();
- error(errinvalidstop);
- }
-
- /* stopped */
-
- void opstopped(void)
- { struct object token, *token1, *tokenx;
- if (opernest == operstacksize) error(errstackoverflow);
- if (currtoken->flags & flagctrl)
- { if (opernest == operstacksize) error(errstackoverflow);
- token.type = typebool;
- token.flags = 0;
- token.length = 0;
- token.value.ival = 0;
- operstack[opernest++] = token;
- execnest -= 2;
- }
- else
- { if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- if (execnest + 3 > execstacksize) error(errexecstackoverflow);
- tokenx = &execstack[execnest];
- tokenx[0] = *token1;
- token = *currtoken;
- token.flags &= ~flagexec;
- token.flags |= flagctrl | flagstop;
- token.length = inest;
- tokenx[1] = token;
- tokenx[2] = *token1;
- execnest += 3;
- opernest--;
- }
- }
-
- /* store */
-
- void opstore(void)
- { struct object token, *token1, *token2;
- int nest;
- if (opernest < 2) error(errstackunderflow);
- token2 = &operstack[opernest - 1];
- token1 = token2 - 1;
- nest = dictfind(token1, &token);
- if (nest == -1) nest = dictnest - 1;
- dictput(dictstack[nest].value.vref, token1, token2);
- opernest -= 2;
- }
-
- /* string */
-
- void opstring(void)
- { struct object token, *token1;
- int length;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- if (token1->type != typeint) error(errtypecheck);
- length = token1->value.ival;
- if (length < 0 || length > 65535) error(errrangecheck);
- token.type = typestring;
- token.flags = 0;
- token.length = token1->value.ival;
- token.value.vref = vmalloc(length);
- *token1 = token;
- }
-
- /* sub */
-
- void opsub(void)
- { struct object token, *token1, *token2;
- int num1, num2;
- if (opernest < 2) error(errstackunderflow);
- token2 = &operstack[opernest - 1];
- token1 = token2 - 1;
- if (token1->type == typeint && token2->type == typeint)
- { num1 = token1->value.ival;
- num2 = token2->value.ival;
- if (num1 > 0 && num2 < 0)
- { num1 -= num2;
- if (num1 > 0)
- { token1->value.ival = num1;
- opernest--;
- return;
- }
- }
- else if (num1 < 0 && num2 > 0)
- { num1 -= num2;
- if (num1 < 0)
- { token1->value.ival = num1;
- opernest--;
- return;
- }
- }
- else
- { num1 -= num2;
- token1->value.ival = num1;
- opernest--;
- return;
- }
- }
- token = *token1;
- if (token.type == typeint)
- { token.type = typereal;
- token.value.rval = token.value.ival;
- }
- else
- if (token.type != typereal) error(errtypecheck);
- if (token2->type == typeint)
- token.value.rval -= token2->value.ival;
- else
- { if (token2->type != typereal) error(errtypecheck);
- token.value.rval -= token2->value.rval;
- }
- *token1 = token;
- opernest--;
- }
-
- /* token */
-
- void optoken(void)
- { struct object token, *token1;
- int bool;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- if (token1->type == typefile)
- { if (opernest + 1 > operstacksize) error(errstackoverflow);
- bool = scantoken(&token, token1, -1);
- if (bool)
- { *token1++ = token;
- opernest++;
- }
- else
- fileclose(token1);
- }
- else if (token1->type == typestring)
- { if (opernest + 2 > operstacksize) error(errstackoverflow);
- bool = scantoken(&token, token1, -1);
- if (bool)
- { token1++;
- *token1++ = token;
- opernest += 2;
- }
- }
- else
- error(errtypecheck);
- token.type = typebool;
- token.flags = 0;
- token.length = 0;
- token.value.ival = bool;
- *token1 = token;
- }
-
- /* truncate */
-
- void optruncate(void)
- { struct object *token1;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- if (token1->type == typeint)
- return;
- else if (token1->type == typereal)
- if (token1->value.rval > 0.0)
- token1->value.rval = (float) floor((double) token1->value.rval);
- else
- token1->value.rval = (float) ceil((double) token1->value.rval);
- else
- error(errtypecheck);
- }
-
- /* type */
-
- void optype(void)
- { struct object token, *token1;
- char *sptr;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- sptr = typetable[token1->type];
- nametoken(&token, sptr, -1, flagexec);
- *token1 = token;
- }
-
- /* usertime */
-
- void opusertime(void)
- { struct object token;
- if (opernest == operstacksize) error(errstackoverflow);
- token.type = typeint;
- token.flags = 0;
- token.length = 0;
- token.value.ival = usertime();
- operstack[opernest++] = token;
- }
-
- /* vmhwm */
-
- void opvmhwm(void)
- { struct object token, *token1;
- if (opernest + 2 > operstacksize) error(errstackoverflow);
- token1 = &operstack[opernest];
- token.type = typeint;
- token.flags = 0;
- token.length = 0;
- token.value.ival = vmhwm;
- token1[0] = token;
- token.value.ival = vmmax;
- token1[1] = token;
- opernest += 2;
- vmhwm = vmused;
- }
-
- /* vmstatus */
-
- void opvmstatus(void)
- { struct object token, *token1;
- if (opernest + 3 > operstacksize) error(errstackoverflow);
- token1 = &operstack[opernest];
- token.type = typeint;
- token.flags = 0;
- token.length = 0;
- token.value.ival = vmnest;
- token1[0] = token;
- token.value.ival = vmused;
- token1[1] = token;
- token.value.ival = vmmax;
- token1[2] = token;
- opernest += 3;
- }
-
- /* wcheck */
-
- void opwcheck(void)
- { struct object token, *token1;
- int type, bool;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- type = token1->type;
- if (type == typefile || type == typestring ||
- type == typearray || type == typepacked)
- bool = ((token1->flags & flagwprot) == 0);
- else if (type == typedict)
- bool = ((vmdptr(token1->value.vref)->flags & flagwprot) == 0);
- else
- error(errtypecheck);
- token.type = typebool;
- token.flags = 0;
- token.length = 0;
- token.value.ival = bool;
- *token1 = token;
- }
-
- /* where */
-
- void opwhere(void)
- { struct object token, *token1;
- int nest;
- if (opernest < 1) error(errstackunderflow);
- if (opernest + 2 > operstacksize) error(errstackoverflow);
- token1 = &operstack[opernest - 1];
- nest = dictfind(token1, &token);
- token.type = typebool;
- token.flags = 0;
- token.length = 0;
- token.value.ival = 0;
- if (nest != -1)
- { *token1++ = dictstack[nest];
- opernest++;
- token.value.ival = 1;
- }
- *token1 = token;
- }
-
- /* write */
-
- void opwrite(void)
- { struct object *token1, *token2;
- struct file *file;
- if (opernest < 2) error(errstackunderflow);
- token2 = &operstack[opernest - 1];
- token1 = token2 - 1;
- if (token1->type != typefile) error(errtypecheck);
- if (token1->flags & flagwprot) error(errinvalidaccess);
- file = filecheck(token1, openwrite);
- if (file == NULL) error(errioerror);
- if (token2->type != typeint) error(errtypecheck);
- if (putc(token2->value.ival, file->fptr) == EOF) error(errioerror);
- opernest -= 2;
- }
-
- /* writehexstring */
-
- void opwritehexstring(void)
- { struct object *token1, *token2;
- struct file *file;
- FILE *fptr;
- char *sptr;
- int length, ch, num;
- if (opernest < 2) error(errstackunderflow);
- token2 = &operstack[opernest - 1];
- token1 = token2 - 1;
- if (token1->type != typefile) error(errtypecheck);
- if (token1->flags & flagwprot) error(errinvalidaccess);
- file = filecheck(token1, openwrite);
- if (file == NULL) error(errioerror);
- fptr = file->fptr;
- if (token2->type != typestring) error(errtypecheck);
- if (token2->flags & flagrprot) error(errinvalidaccess);
- length = token2->length;
- sptr = vmsptr(token2->value.vref);
- while (length--)
- { num = *(unsigned char *)(sptr++);
- ch = num >> 4;
- ch += (ch < 10) ? '0' : 'a' - 10;
- if (putc(ch, fptr) == EOF) error(errioerror);
- ch = num & 15;
- ch += (ch < 10) ? '0' : 'a' - 10;
- if (putc(ch, fptr) == EOF) error(errioerror);
- }
- opernest -= 2;
- }
-
- /* writestring */
-
- void opwritestring(void)
- { struct object *token1, *token2;
- struct file *file;
- if (opernest < 2) error(errstackunderflow);
- token2 = &operstack[opernest - 1];
- token1 = token2 - 1;
- if (token1->type != typefile) error(errtypecheck);
- if (token1->flags & flagwprot) error(errinvalidaccess);
- file = filecheck(token1, openwrite);
- if (file == NULL) error(errioerror);
- if (token2->type != typestring) error(errtypecheck);
- if (token2->flags & flagrprot) error(errinvalidaccess);
- putmem(file->fptr, vmsptr(token2->value.vref), token2->length);
- opernest -= 2;
- }
-
- /* xcheck */
-
- void opxcheck(void)
- { struct object token, *token1;
- int bool;
- if (opernest < 1) error(errstackunderflow);
- token1 = &operstack[opernest - 1];
- bool = ((token1->flags & flagexec) != 0);
- token.type = typebool;
- token.flags = 0;
- token.length = 0;
- token.value.ival = bool;
- *token1 = token;
- }
-
- /* xor */
-
- void opxor(void)
- { struct object *token1, *token2;
- if (opernest < 2) error(errstackunderflow);
- token2 = &operstack[opernest - 1];
- token1 = token2 - 1;
- if ((token1->type == typebool && token2->type == typebool) ||
- (token1->type == typeint && token2->type == typeint))
- token1->value.ival ^= token2->value.ival;
- else
- error(errtypecheck);
- opernest--;
- }
-
- /* Initialise the operators (2) */
-
- void initop2(void)
- { systemop(opindex, "index");
- systemop(opknown, "known");
- systemop(ople, "le");
- systemop(oplength, "length");
- systemop(opln, "ln");
- systemop(opload, "load");
- systemop(oplog, "log");
- systemop(oploop, "loop");
- systemop(oplt, "lt");
- systemop(opmaxlength, "maxlength");
- systemop(opmod, "mod");
- systemop(opmul, "mul");
- systemop(opne, "ne");
- systemop(opneg, "neg");
- systemop(opnoaccess, "noaccess");
- systemop(opnot, "not");
- systemop(opnull, "null");
- systemop(opor, "or");
- systemop(oppackedarray, "packedarray");
- systemop(oppop, "pop");
- systemop(opprint, "print");
- systemop(opprompts, "prompts");
- systemop(oppstack, "pstack");
- systemop(opput, "put");
- systemop(opputinterval, "putinterval");
- systemop(opquit, "quit");
- systemop(oprcheck, "rcheck");
- systemop(oprand, "rand");
- systemop(opread, "read");
- systemop(opreadhexstring, "readhexstring");
- systemop(opreadline, "readline");
- systemop(opreadonly, "readonly");
- systemop(opreadstring, "readstring");
- systemop(oprepeat, "repeat");
- systemop(opresetfile, "resetfile");
- systemop(oprestore, "restore");
- systemop(oproll, "roll");
- systemop(opround, "round");
- systemop(oprrand, "rrand");
- systemop(oprun, "run");
- systemop(opsave, "save");
- systemop(opsearch, "search");
- systemop(opsetpacking, "setpacking");
- systemop(opsin, "sin");
- systemop(opsqrt, "sqrt");
- systemop(opsrand, "srand");
- systemop(opstack, "stack");
- systemop(opstatus, "status");
- systemop(opstop, "stop");
- systemop(opstopped, "stopped");
- systemop(opstore, "store");
- systemop(opstring, "string");
- systemop(opsub, "sub");
- systemop(optoken, "token");
- systemop(optruncate, "truncate");
- systemop(optype, "type");
- systemop(opusertime, "usertime");
- systemop(opvmhwm, "vmhwm");
- systemop(opvmstatus, "vmstatus");
- systemop(opwcheck, "wcheck");
- systemop(opwhere, "where");
- systemop(opwrite, "write");
- systemop(opwritehexstring, "writehexstring");
- systemop(opwritestring, "writestring");
- systemop(opxcheck, "xcheck");
- systemop(opxor, "xor");
- }
-
- /* End of file "postop2.c" */
-