/* * @(#)operators.h.ref 9.11 88/02/10 */ /* * operators.h: Primitive PostScript operators * * (C) Copyright 1987 Sun Microsystems, Inc. * * This file is included by PostScript.c. It contains the definitions for all of * the primitive operators. Think of each of the cases as a seperate * procedure declaration. */ #ifdef GPROF_HOOKS asm(".globl gP_AbsPrim, gP_AccptPrim, gP_ContAccptPrim, gP_ArcPrim"); asm(".globl gP_ArcnPrim, gP_AcosPrim, gP_ArctoPrim, gP_AddPrim"); asm(".globl gP_AloadPrim, gP_AndPrim, gP_ArrayPrim, gP_AshowPrim"); asm(".globl gP_AsinPrim, gP_AstorePrim, gP_AwidshPrim, gP_BeginPrim"); asm(".globl gP_BitshftPrim, gP_BrkpntPrim, gP_BuildiPrim, gP_ForPrim"); asm(".globl gP_CeilPrim, gP_CleartomPrim, gP_ClearPrim, gP_CleverPrintPrim"); asm(".globl gP_ClipPrim, gP_ClippathPrim, gP_ClosepathPrim, gP_CtrlpntPrim"); asm(".globl gP_CosPrim, gP_CntdstckPrim, gP_CntexstckPrim, gP_CnttomrkPrim"); asm(".globl gP_CountPrim, gP_CurdictPrim, gP_CurfontPrim, gP_CurgrayPrim"); asm(".globl gP_CurlcapPrim, gP_CurljoinPrim, gP_CurlwidPrim, gP_CurmatPrim"); asm(".globl gP_CurmiterPrim, gP_CurpntPrim, gP_CurpmatchPrim, gP_CviPrim"); asm(".globl gP_CvlitPrim, gP_CvnPrim, gP_CvrPrim, gP_CvsPrim, gP_PopPrim"); asm(".globl gP_CvxPrim, gP_DefmatPrim, gP_StorePrim, gP_DefPrim, gP_DictPrim"); asm(".globl gP_DivPrim, gP_DtransPrim, gP_DupPrim, gP_EndPrim, gP_EoclipPrim"); asm(".globl gP_EofillPrim, gP_EqPrim, gP_ErpgPrim, gP_ExchPrim, gP_ExecPrim"); asm(".globl gP_ExitPrim, gP_ExpPrim, gP_FalsePrim, gP_FilePrim, gP_FillPrim"); asm(".globl gP_FloorPrim, gP_FlushfPrim, gP_FlushPrim, gP_ForallPrim"); asm(".globl gP_ForkPrim, gP_GetintvlPrim, gP_GetPrim, gP_GePrim"); asm(".globl gP_GrestallPrim, gP_IdtransPrim, gP_InitgrphPrim, gP_RotPrim"); asm(".globl gP_GrestPrim, gP_GsavePrim, gP_GtPrim, gP_IdivPrim"); asm(".globl gP_IfelsePrim, gP_IfPrim, gP_IndexPrim, gP_InitclpPrim"); asm(".globl gP_InitmatPrim, gP_AwaitPrim, gP_RstrtAwtPrim, gP_ItransPrim"); asm(".globl gP_KnownPrim, gP_LenPrim, gP_LePrim, gP_LinetoPrim, gP_LnPrim"); asm(".globl gP_LoadPrim, gP_LogPrim, gP_LoopPrim, gP_LtPrim, gP_MarkPrim"); asm(".globl gP_MaxPrim, gP_MaxlenPrim, gP_MinPrim, gP_ModPrim, gP_MonitorPrim"); asm(".globl gP_MovetoPrim, gP_MulPrim, gP_NegPrim, gP_NewpathPrim, gP_NePrim"); asm(".globl gP_NotPrim, gP_NullPrim, gP_OrPrim, gP_PathbbPrim, gP_PathfavPrim"); asm(".globl gP_PausePrim, gP_ExitlPrim, gP_PrintPrim, gP_PutPrim, gP_QuitPrim"); asm(".globl gP_DoQuit, gP_RandPrim, gP_RchkPrim, gP_RctrlpntPrim, gP_ReadPrim"); asm(".globl gP_ReadhexPrim, gP_ReadlnPrim, gP_ReadonlPrim, gP_ReadstrPrim"); asm(".globl gP_RepeatPrim, gP_RlinePrim, gP_RmovePrim, gP_RollPrim"); asm(".globl gP_RoundPrim, gP_ScalePrim, gP_ScalefntPrim, gP_SetcanPrim"); asm(".globl gP_SetgryPrim, gP_SetlcapPrim, gP_SetljoinPrim, gP_SetlwidPrim"); asm(".globl gP_SetmatPrim, gP_SetmiterPrim, gP_SetprntPrim, gP_ShowPrim"); asm(".globl gP_SinPrim, gP_SqrtPrim, gP_StatusPrim, gP_StoppedPrim"); asm(".globl gP_StringPrim, gP_StrwidPrim, gP_StrokePrim, gP_SubPrim"); asm(".globl gP_SysdictPrim, gP_TokenPrim, gP_TransformPrim, gP_TranslatePrim"); asm(".globl gP_TruePrim, gP_TruncPrim, gP_TypePrim, gP_VersPrim, gP_WaitPrim"); asm(".globl gP_CntWaitPrim, gP_WchkPrim, gP_WidshowPrim, gP_WritePrim"); asm(".globl gP_XchkPrim, gP_XorPrim, gP_ResultBase"); asm(".globl gP_LineFixReal, gP_LineRealFix, gP_LineRealReal, gP_SetfntPrim"); asm(".globl gP_StopPrim, gP_LineFixFix, gP_ResultBaseB"); #endif #define call(fn) fn; #define ABS(x) ((x) < 0 ? -(x) : (x)) /* * This is a version of getc that pauses if the buffer is empty and suspends * the process; note that file could get closed during the pause, so you * must check */ #define pgetc(e,c,f) \ psio_pgetc(f, c, \ ee->restart_state = e; \ ee->event = psio_fileno(f) + 1; \ goto suspend_process; \ CPPCONCAT(read_,e): \ if (f == 0 || psio_error(f)) \ goto ioerror_error; \ ) #ifdef undef #define pgetc(e,c,f) { \ if (--(f)->_cnt>=0) c = *(f)->_ptr++&0377; \ else { \ ee->restart_state = e; \ ee->event = fileno(f) + 1; \ goto suspend_process; \ CPPCONCAT(read_,e): \ c = _filbuf(f); \ } \ } #endif #define QUAD(x, q) (x >= 0 ? 1 : q) #define F1 fracti(1) #ifdef undef keep_indent_happy() { #endif switch (ee->execee.value.def->index) { case abs_primitive: #ifdef GPROF_HOOKS asm("gP_AbsPrim:"); #endif switch (optop[-1].type) { case real_type: if (optop[-1].value.real < 0) optop[-1].value.real = -optop[-1].value.real; break; case fixed_type: if (optop[-1].value.fixed < 0) optop[-1].value.fixed = -optop[-1].value.fixed; break; default: goto typecheck_error; } break; case acceptconnection_primitive: #ifdef GPROF_HOOKS asm("gP_AccptPrim:"); #endif if (optop[-1].type != file_type || body_of(optop - 1)->body.file.inbuf == 0) goto typecheck_error; ee->restart_state = 11; ee->event = psio_fileno(body_of(optop - 1)->body.file.inbuf) + 1; goto suspend_process; read_11: #ifdef GPROF_HOOKS asm("gP_ContAccptPrim:"); #endif { register struct body *b; register fd; fd = accept_connect(psio_fileno(body_of(optop - 1)->body.file.inbuf)); if (fd < 0) { perror("accept"); goto accept_error; } else if (verbose) psio_fprintf(ee->stddiag->body.file.outbuf, "Accepted new connection on fd %d\n", fd); if (fd >= maximum_fd) maximum_fd = fd + 1; fcntl(fd, F_SETFD, 1); fcntl(fd, F_SETFL, O_NDELAY); b = new_body(file); set_typed_bodied_object(&new, file_type, b); b->type = file_type; b->body.file.name = 0; b->body.file.inbuf = psio_fdopen(fd, "r"); b->body.file.outbuf = psio_fdopen(fd, "w"); b->body.file.tok = 0; b->body.file.ntok = 0; } goto typed_result; case arc_primitive:{ register int i; #ifdef GPROF_HOOKS asm("gP_ArcPrim:"); #endif for (i = -1; i >= -5; i--) switch (optop[i].type) { default: goto typecheck_error; case real_type: optop[i].value.fixed = fractf(optop[i].value.real); optop[i].type = fixed_type; case fixed_type:; } cs_frarc(&ee->gontext, optop[-5].value.fixed, optop[-4].value.fixed, optop[-3].value.fixed, optop[-2].value.fixed, optop[-1].value.fixed); optop -= 5; break; } case arcn_primitive:{ register int i; #ifdef GPROF_HOOKS asm("gP_ArcnPrim:"); #endif for (i = -1; i >= -5; i--) switch (optop[i].type) { default: goto typecheck_error; case real_type: optop[i].value.fixed = fractf(optop[i].value.real); optop[i].type = fixed_type; case fixed_type:; } cs_frarcn(&ee->gontext, optop[-5].value.fixed, optop[-4].value.fixed, optop[-3].value.fixed, optop[-2].value.fixed, optop[-1].value.fixed); optop -= 5; break; } case arccos_primitive: #ifdef GPROF_HOOKS asm("gP_AcosPrim:"); #endif switch (optop[-1].type) { default: goto typecheck_error; case real_type: optop[-1].value.fixed = fractf(optop[-1].value.real); optop[-1].type = fixed_type; case fixed_type:; } if (optop[-1].value.fixed < fracti(-1) || optop[-1].value.fixed > F1) goto undefinedresult_error; optop[-1].value.fixed = frarccosd(optop[-1].value.fixed, QUAD(optop[-1].value.fixed, 2)); break; case arcto_primitive:{ register int i; #ifdef GPROF_HOOKS asm("gP_ArctoPrim:"); #endif for (i = -1; i >= -5; i--) switch (optop[i].type) { default: goto typecheck_error; case real_type: optop[i].value.fixed = fractf(optop[i].value.real); optop[i].type = fixed_type; case fixed_type:; } cs_frarcto(&ee->gontext, optop[-5].value.fixed, optop[-4].value.fixed, optop[-3].value.fixed, optop[-2].value.fixed, optop[-1].value.fixed, &optop[-5].value.fixed, &optop[-4].value.fixed, &optop[-3].value.fixed, &optop[-2].value.fixed); optop--; break; } case add_primitive: #ifdef GPROF_HOOKS asm("gP_AddPrim:"); #endif binary_primitive(+, vfradd); break; case aload_primitive: #ifdef GPROF_HOOKS asm("gP_AloadPrim:"); #endif if (optop[-1].type != array_type) goto typecheck_error; overflow_check(optop[-1].value.substring.length); { struct object copied_array; register struct object *p; register n; copied_array = optop[-1]; n = optop[-1].value.substring.length; p = body_of(optop - 1)->body.array.objects + optop[-1].value.substring.start; while (--n >= 0) { optop[-1] = *p++; object_incref(optop - 1); optop++; } optop[-1] = copied_array; } break; case and_primitive: #ifdef GPROF_HOOKS asm("gP_AndPrim:"); #endif boolean_binary_primitive(&); case array_primitive: #ifdef GPROF_HOOKS asm("gP_ArrayPrim:"); #endif if (optop[-1].type != fixed_type) goto typecheck_error; { register size = roundfr(optop[-1].value.fixed); register struct body *arr; if (size < 0) goto rangecheck_error; new = make_array(size); arr = body_of(&new); bzero(arr->body.array.objects, size * sizeof(struct object)); new.value.subarray.length = arr->body.array.used = arr->body.array.size; } goto typed_result; case ashow_primitive: #ifdef GPROF_HOOKS asm("gP_AshowPrim:"); #endif if (optop[-1].type != string_type || optop[-2].type != fixed_type || optop[-3].type != fixed_type) goto typecheck_error; if (!cs_hascurrentpoint(&ee->gontext)) goto nocurrentpoint_error; ee->optop = optop; ee->pos = es; cs_frcashow(&ee->gontext, optop[-3].value.fixed, optop[-2].value.fixed, body_of(optop - 1)->body.string.chars + optop[-1].value.substring.start, optop[-1].value.substring.length); es = ee->pos; optop = ee->optop; object_decref(optop - 1); optop -= 3; break; case arcsin_primitive: #ifdef GPROF_HOOKS asm("gP_AsinPrim:"); #endif switch (optop[-1].type) { default: goto typecheck_error; case real_type: optop[-1].value.fixed = fractf(optop[-1].value.real); optop[-1].type = fixed_type; case fixed_type:; } if (optop[-1].value.fixed < fracti(-1) || optop[-1].value.fixed > F1) goto undefinedresult_error; optop[-1].value.fixed = frarccosd(frsqrt(F1 - frsq(optop[-1].value.fixed)), QUAD(optop[-1].value.fixed, 4)); break; case astore_primitive: #ifdef GPROF_HOOKS asm("gP_AstorePrim:"); #endif if (optop[-1].type != array_type) goto typecheck_error; if (optop - new.value.subarray.length <= ee->underflow) goto stack_underflow; new = *--optop; { register struct object *astore_p = body_of(&new)->body.array.objects + new.value.subarray.start; register astore_cnt = new.value.subarray.length; while (--astore_cnt >= 0) { object_decref(astore_p); astore_p++; } } bcopy(optop = optop - new.value.subarray.length, body_of(&new)->body.array.objects + new.value.subarray.start, new.value.subarray.length * sizeof(struct object)); *optop++ = new; break; case awidthshow_primitive: #ifdef GPROF_HOOKS asm("gP_AwidshPrim:"); #endif if (optop[-1].type != string_type || optop[-2].type != fixed_type || optop[-3].type != fixed_type || optop[-4].type != fixed_type || optop[-5].type != fixed_type || optop[-6].type != fixed_type) goto typecheck_error; if (!cs_hascurrentpoint(&ee->gontext)) goto nocurrentpoint_error; ee->optop = optop; ee->pos = es; cs_frcawidthshow(&ee->gontext, optop[-6].value.fixed, optop[-5].value.fixed, cfloorfr(optop[-4].value.fixed), optop[-3].value.fixed, optop[-2].value.fixed, body_of(optop - 1)->body.string.chars + optop[-1].value.substring.start, optop[-1].value.substring.length); es = ee->pos; optop = ee->optop; object_decref(optop - 1); optop -= 6; break; case begin_primitive: #ifdef GPROF_HOOKS asm("gP_BeginPrim:"); #endif if (!have_dict_space(ee, 1)) goto handle_error; { register struct body *b; switch (optop[-1].type) { case dictionary_type: b = body_of(optop - 1); ee->dict_top->obj = 0; break; default: b = dict_table[(int) optop[-1].type]; if (b == 0 || (ee->dict_top->obj = body_of(optop - 1)) == 0) goto typecheck_error; break; } ee->dict_top->body = b; } optop--; ee->dict_top++; break; case bitshift_primitive: #ifdef GPROF_HOOKS asm("gP_BitshftPrim:"); #endif if (optop[-1].type != fixed_type && optop[-2].type != fixed_type) goto typecheck_error; optop[-2].value.fixed = optop[-1].value.fixed >= 0 ? optop[-2].value.fixed << cfloorfr(optop[-1].value.fixed) : optop[-2].value.fixed >> -cfloorfr(optop[-1].value.fixed); optop--; break; case breakpoint_primitive: #ifdef GPROF_HOOKS asm("gP_BrkpntPrim:"); #endif ee->event = suspended_process; ee->restart_state = 0; goto suspend_process; case buildimage_primitive: #ifdef GPROF_HOOKS asm("gP_BuildiPrim:"); #endif if (optop[-2].type != array_type || optop[-3].type != fixed_type || optop[-4].type != fixed_type || optop[-5].type != fixed_type) goto typecheck_error; { extern struct pixrect *mem_create(); short depth = cfloorfr(optop[-3].value.fixed), height = cfloorfr(optop[-4].value.fixed), width = cfloorfr(optop[-5].value.fixed); if (height <= 0 || width <= 0) goto undefinedresult_error; if (es >= ee->limit) error(stackoverflow); switch (depth) { case 24: case 8: es[1].env.image.remrow = width * (depth >> 3); break; case 4: es[1].env.image.remrow = (width + 1) >> 1; break; case 1: es[1].env.image.remrow = (width + 7) >> 3; break; default: goto undefinedresult_error; } /* setup transform */ object_decref(optop - 2); if (optop[-1].type == null_type) { create_object_from_image(optop-5, mem_create(width, height, depth)); optop++; } else { es++; es->type = buildimage_execution; es->executed = optop[-1]; es->env.image.image = mem_create(width, height, depth); es->env.image.pos = 0; es->env.image.remaining = es->env.image.remrow * height; es->env.image.first = 1; } optop -= 5; break; } case ceiling_primitive: #ifdef GPROF_HOOKS asm("gP_CeilPrim:"); #endif switch (optop[-1].type) { case real_type: optop[-1].value.real = ceil(optop[-1].value.real); break; case fixed_type: optop[-1].value.fixed = fracti(ceilingfr(optop[-1].value.fixed)); break; default: goto typecheck_error; } break; case cleartomark_primitive: #ifdef GPROF_HOOKS asm("gP_CleartomPrim:"); #endif while (optop > ee->underflow) { optop--; if (optop->type == marker_type) break; object_decref(optop); } break; case clear_primitive: #ifdef GPROF_HOOKS asm("gP_ClearPrim:"); #endif while (optop > ee->underflow) { optop--; object_decref(optop); } optop = ee->underflow; break; case cleverprint_primitive: { register PSFILE *psf = ee->stdprnt->body.file.outbuf; #ifdef GPROF_HOOKS asm("gP_CleverPrintPrim:"); #endif if (psf == 0 || psio_error(psf)) goto ioerror_error; decode_object(psf, optop[-1], 99); psio_fprintf(psf, "\n"); optop--; object_decref(optop); } break; case clip_primitive: #ifdef GPROF_HOOKS asm("gP_ClipPrim:"); #endif cs_clip(&ee->gontext); break; case clippath_primitive: #ifdef GPROF_HOOKS asm("gP_ClippathPrim:"); #endif cs_clippath(&ee->gontext); break; case closepath_primitive: #ifdef GPROF_HOOKS asm("gP_ClosepathPrim:"); #endif cs_closepath(&ee->gontext); break; case controlpoint_primitive: { fract variation; #ifdef GPROF_HOOKS asm("gP_CtrlpntPrim:"); #endif if (optop[-1].type == fixed_type) variation = optop[-1].value.fixed; else if (optop[-1].type == real_type) variation = fractf(optop[-1].value.real); else goto typecheck_error; switch (object_type_pair(optop[-3], optop[-2])) { case tp(fixed, fixed): cs_frlineby(&ee->gontext, optop[-3].value.fixed, optop[-2].value.fixed, variation); break; case tp(fixed, real): cs_fllineby(&ee->gontext, floatfr(optop[-3].value.fixed), optop[-2].value.real, variation); break; case tp(real, fixed): cs_fllineby(&ee->gontext, optop[-3].value.real, floatfr(optop[-2].value.fixed), variation); break; case tp(real, real): cs_fllineby(&ee->gontext, optop[-3].value.real, optop[-2].value.real, variation); break; default: goto typecheck_error; } } optop -= 3; break; case cos_primitive: { fract temp; #ifdef GPROF_HOOKS asm("gP_CosPrim:"); #endif if (optop[-1].type == fixed_type) frsincosd(optop[-1].value.fixed, &temp, &optop[-1].value.fixed); else if (optop[-1].type == real_type) { frsincosd(fractf(optop[-1].value.real), &temp, &optop[-1].value.fixed); optop[-1].type = fixed_type; } else goto typecheck_error; } break; case countdictstack_primitive: #ifdef GPROF_HOOKS asm("gP_CntdstckPrim:"); #endif set_fixed_object(optop, fracti(ee->dict_top - ee->dictionary_stack)); optop++; break; case countexecstack_primitive: #ifdef GPROF_HOOKS asm("gP_CntexstckPrim:"); #endif set_fixed_object(optop, fracti(es - ee->execution_stack + 1)); optop++; break; case counttomark_primitive: { register struct object *p = optop; #ifdef GPROF_HOOKS asm("gP_CnttomrkPrim:"); #endif while (--p >= ee->underflow) if (p->type == marker_type) goto fixed_result; else new.value.fixed += F1; goto stack_underflow; } case count_primitive: #ifdef GPROF_HOOKS asm("gP_CountPrim:"); #endif new.value.fixed = fracti(optop - ee->underflow); goto fixed_result; case currentdict_primitive: #ifdef GPROF_HOOKS asm("gP_CurdictPrim:"); #endif if (ee->dict_top[-1].obj) { register struct body *curdbod = ee->dict_top[-1].obj; set_typed_bodied_object(&new, curdbod->type, curdbod); switch(curdbod->type) { case canvas_type: new.value.canvas = curdbod->body.canvas.canvas; break; } } else { set_typed_bodied_object(&new, dictionary_type, ee->dict_top[-1].body); } object_incref(&new); goto typed_result; case currentfont_primitive: #ifdef GPROF_HOOKS asm("gP_CurfontPrim:"); #endif if (cs_currentfont(&ee->gontext) == 0) goto undefined_error; { register struct body *b = new_body(font); set_typed_bodied_object(optop, font_id_type, b); b->type = font_id_type; b->body.font = cs_currentfont(&ee->gontext); psf_incref(b->body.font); optop++; } break; case currentgray_primitive: #ifdef GPROF_HOOKS asm("gP_CurgrayPrim:"); #endif new.value.fixed = cs_frcurrentgray(&ee->gontext); goto fixed_result; case currentlinecap_primitive: #ifdef GPROF_HOOKS asm("gP_CurlcapPrim:"); #endif new.value.fixed = fracti((int) cs_currentlinecap(&ee->gontext)); goto fixed_result; case currentlinejoin_primitive: #ifdef GPROF_HOOKS asm("gP_CurljoinPrim:"); #endif new.value.fixed = fracti((int) cs_currentlinejoin(&ee->gontext)); goto fixed_result; case currentlinewidth_primitive: #ifdef GPROF_HOOKS asm("gP_CurlwidPrim:"); #endif new.value.fixed = cs_frcurrentlinewidth(&ee->gontext); goto fixed_result; case currentmatrix_primitive: { register struct object *p = result_matrix(optop[-1]); register i; FMATRIX matrix; #ifdef GPROF_HOOKS asm("gP_CurmatPrim:"); #endif if (p == 0) goto typecheck_error; cs_currentmatrix(&ee->gontext, matrix); p[0].value.fixed = matrix[0][0]; p[1].value.fixed = matrix[0][1]; p[2].value.fixed = matrix[1][0]; p[3].value.fixed = matrix[1][1]; p[4].value.fixed = matrix[2][0]; p[5].value.fixed = matrix[2][1]; } break; case currentmiterlimit_primitive: #ifdef GPROF_HOOKS asm("gP_CurmiterPrim:"); #endif new.value.fixed = cs_currentmiterlimit(&ee->gontext); goto fixed_result; case currentpoint_primitive: #ifdef GPROF_HOOKS asm("gP_CurpntPrim:"); #endif if (!cs_hascurrentpoint(&ee->gontext)) goto nocurrentpoint_error; cs_frcurrentpoint(&ee->gontext, &optop[0].value.fixed, &optop[1].value.fixed); set_typed_object(optop, fixed_type); set_typed_object(optop + 1, fixed_type); optop += 2; break; case currentprintermatch_primitive: #ifdef GPROF_HOOKS asm("gP_CurpmatchPrim:"); #endif set_typed_object(optop, boolean_type); optop[0].value.fixed = fracti(cs_currentprintermatch(&ee->gontext)); optop++; break; case cvi_primitive: #ifdef GPROF_HOOKS asm("gP_CviPrim:"); #endif switch (optop[-1].type) { case fixed_type: new.value.fixed = optop[-1].value.fixed; break; case string_type: { double atof(); register char *s = body_of(optop - 1)->body.string.chars + optop[-1].value.substring.start; char c = s[optop[-1].value.substring.length]; s[optop[-1].value.substring.length] = 0; new.value.real = atof(s); s[optop[-1].value.substring.length] = c; cvi_range_check: if (new.value.real > floatfr(FRHUGE) || new.value.real < -floatfr(FRHUGE)) goto rangecheck_error; new.value.fixed = fractf(new.value.real); } break; case real_type: new.value.real = optop[-1].value.real; goto cvi_range_check; default: goto typecheck_error; } new.value.fixed = fracti(floorfr(new.value.fixed)); goto fixed_result; case cvlit_primitive: #ifdef GPROF_HOOKS asm("gP_CvlitPrim:"); #endif optop[-1].executable = 0; break; case cvn_primitive: #ifdef GPROF_HOOKS asm("gP_CvnPrim:"); #endif if (optop[-1].type == keyword_type) break; if (optop[-1].type != string_type) goto typecheck_error; set_typed_bodied_object(&new, keyword_type, get_name(body_of(optop - 1)->body.string.chars + optop[-1].value.substring.start, optop[-1].value.substring.length)); goto typed_result; case cvr_primitive: #ifdef GPROF_HOOKS asm("gP_CvrPrim:"); #endif if (optop[-1].type != real_type) { if (optop[-1].type == fixed_type) new.value.real = floatfr(optop[-1].value.fixed); else if (optop[-1].type == string_type) { double atof(); register float V; register char *s = body_of(optop - 1)->body.string.chars + optop[-1].value.substring.start; char c = s[optop[-1].value.substring.length]; s[optop[-1].value.substring.length] = 0; V = atof(s); s[optop[-1].value.substring.length] = c; if ((new.value.real = V) < 0) V = -V; if (V < (1 << 15) && V > 1.0 / (1 << 6)) { new.value.fixed = fracti(V); goto fixed_result; } } else goto typecheck_error; goto real_result; } break; case cvsprint_primitive: { register PSFILE *psf = ee->stdprnt->body.file.outbuf; #ifdef GPROF_HOOKS asm("gP_CvsPrim:"); #endif if (psf == 0 || psio_error(psf)) goto ioerror_error; decode_object(psf, optop[-1], 0); psio_fprintf(psf, "\n"); } /* fall thru */ case pop_primitive: #ifdef GPROF_HOOKS asm("gP_PopPrim:"); #endif optop--; object_decref(optop); break; case cvx_primitive: #ifdef GPROF_HOOKS asm("gP_CvxPrim:"); #endif optop[-1].executable = 1; break; case defaultmatrix_primitive: { register struct object *p = result_matrix(optop[-1]); register FMATRIX *tr; #ifdef GPROF_HOOKS asm("gP_DefmatPrim:"); #endif tr = cs_defaultmatrix(cs_currentcanvas(&ee->gontext)); if (p == 0) goto typecheck_error; p[0].value.fixed = (*tr)[0][0]; p[1].value.fixed = (*tr)[0][1]; p[2].value.fixed = (*tr)[1][0]; p[3].value.fixed = (*tr)[1][1]; p[4].value.fixed = (*tr)[2][0]; p[5].value.fixed = (*tr)[2][1]; } break; case store_primitive: { register struct dictstack_ent *stackent = ee->dict_top; register hash; #ifdef GPROF_HOOKS asm("gP_StorePrim:"); #endif if (optop[-2].type == string_type) convert_string_to_name(optop - 2); hash_object(hash, &optop[-2]); while (--stackent >= ee->dictionary_stack) { register struct object *ret = &stackent->body->body.array.objects[ hash_index(hash, stackent->body->body.array.size >> 1)]; while (ret->type != null_type) { if (equal_object(ret, &optop[-2])) { object_decref(&ret[1]); ret[1] = optop[-1]; object_decref(&optop[-2]); optop -= 2; goto finished_result; } ret -= 2; if (ret < stackent->body->body.array.objects) ret = &stackent->body->body.array.objects[stackent->body->body.array.size - 2]; } } } /* FALL THROUGH */ case def_primitive: #ifdef GPROF_HOOKS asm("gP_DefPrim:"); #endif if (ee->dict_top[-1].body->readonly) error(invalidaccess); if (ee->dict_top[-1].obj) { if (ee->dict_top[-1].obj->readonly) error(invalidaccess); if (optop[-2].type == string_type) convert_string_to_name(optop - 2); define_object_in_dictionary(optop[-2], optop[-1], ee->dict_top[-1].body, ee->dict_top[-1].obj); } else { if (optop[-2].type == string_type) convert_string_to_name(optop - 2); define_object_in_dictionary(optop[-2], optop[-1], ee->dict_top[-1].body, 0); } if (ee->error_code) goto handle_error; object_decref(optop - 2); optop -= 2; break; case dict_primitive: #ifdef GPROF_HOOKS asm("gP_DictPrim:"); #endif if (optop[-1].type != fixed_type) goto typecheck_error; set_typed_bodied_object(&new, dictionary_type, new_dict(roundfr(optop[-1].value.fixed))); goto typed_result; case div_primitive: #ifdef GPROF_HOOKS asm("gP_DivPrim:"); #endif if (optop[-1].type == fixed_type) if (optop[-1].value.fixed == 0) goto undefinedresult_error; else if (optop[-1].type == real_type) if (optop[-1].value.real == 0.0) goto undefinedresult_error; binary_primitive(/, vfrdiv); break; case dtransform_primitive: #ifdef GPROF_HOOKS asm("gP_DtransPrim:"); #endif if (optop[-1].type == array_type && optop[-1].value.subarray.length >= 6) { fract matrix[6] /* [3][2] */ ; register struct object *p; register int i = 6; p = &body_of(&optop[-1])-> body.array.objects[optop[-1].value.subarray.start]; while (i-- > 0) switch (p[i].type) { case fixed_type: matrix[i] = p[i].value.fixed; break; case real_type: matrix[i] = fractf(p[i].value.real); break; default: goto typecheck_error; } optop--; switch (object_type_pair(optop[-2], optop[-1])) { case tp(fixed, fixed): sh_frmdtransform(matrix, optop[-2].value.fixed, optop[-1].value.fixed); break; case tp(fixed, real): sh_frmdtransform(matrix, optop[-2].value.fixed, fractf(optop[-1].value.real)); break; case tp(real, fixed): sh_frmdtransform(matrix, fractf(optop[-2].value.real), optop[-1].value.fixed); break; case tp(real, real): sh_frmdtransform(matrix, fractf(optop[-2].value.real), fractf(optop[-1].value.real)); break; } optop[-2].value.fixed = shape_point.x; optop[-2].type = fixed_type; optop[-1].value.fixed = shape_point.y; optop[-1].type = fixed_type; } else switch (object_type_pair(optop[-2], optop[-1])) { case tp(fixed, fixed): cs_frdtransform(&ee->gontext, optop[-2].value.fixed, optop[-1].value.fixed, &optop[-2].value.fixed, &optop[-1].value.fixed); break; case tp(fixed, real): cs_fldtransform(&ee->gontext, floatfr(optop[-2].value.fixed), optop[-1].value.real, &optop[-2].value.fixed, &optop[-1].value.fixed); set_typed_object(optop - 1, fixed_type); break; case tp(real, fixed): cs_fldtransform(&ee->gontext, optop[-2].value.real, floatfr(optop[-1].value.fixed), &optop[-2].value.fixed, &optop[-1].value.fixed); set_typed_object(optop - 2, fixed_type); break; case tp(real, real): cs_fldtransform(&ee->gontext, optop[-2].value.real, optop[-1].value.real, &optop[-2].value.fixed, &optop[-1].value.fixed); set_typed_object(optop - 1, fixed_type); set_typed_object(optop - 2, fixed_type); break; default: goto typecheck_error; } break; case dup_primitive: #ifdef GPROF_HOOKS asm("gP_DupPrim:"); #endif optop[0] = optop[-1]; object_incref(optop); optop++; break; case end_primitive: #ifdef GPROF_HOOKS asm("gP_EndPrim:"); #endif if (ee->dict_top <= ee->dictionary_stack + 1) { error(dictstackunderflow); } else { if (ee->dict_top[-1].obj) { decref(ee->dict_top[-1].obj); } else decref(ee->dict_top[-1].body); ee->dict_top--; } break; case eoclip_primitive: #ifdef GPROF_HOOKS asm("gP_EoclipPrim:"); #endif cs_eoclip(&ee->gontext); break; case eofill_primitive: #ifdef GPROF_HOOKS asm("gP_EofillPrim:"); #endif cs_eofill(&ee->gontext); break; case eq_primitive: #ifdef GPROF_HOOKS asm("gP_EqPrim:"); #endif if (equal_object(optop - 2, optop - 1) || PerformCompare(optop[-2], optop[-1]) == 2) new.value.fixed = F1; goto boolean_result; case erasepage_primitive: #ifdef GPROF_HOOKS asm("gP_ErpgPrim:"); #endif cs_erasepage(&ee->gontext); break; case exch_primitive: #ifdef GPROF_HOOKS asm("gP_ExchPrim:"); #endif new = optop[-2]; optop[-2] = optop[-1]; optop[-1] = new; break; case exec_primitive: #ifdef GPROF_HOOKS asm("gP_ExecPrim:"); #endif optop--; ee->execee = *optop; goto execute_top; case exit_primitive: { register struct execution_stack *p = es; #ifdef GPROF_HOOKS asm("gP_ExitPrim:"); #endif while (p >= ee->execution_stack && p->type != fixed_for_execution && p->type != real_for_execution && p->type != forall_execution && p->type != monitor_execution && p->type != pathforall_execution && p->type != send_execution && p->type != stopped_execution) p--; if (p <= ee->execution_stack) goto do_quit_primitive; if (p->type == stopped_execution) goto invalidexit_error; while (es >= p) { switch (es->type) { case forall_execution: object_decref(&es->env.forall); break; case monitor_execution: disentangle_monitor(ee, body_of(&es->env.monitor)); break; case buildimage_execution: pr_destroy(es->env.image.image); break; case send_execution: ee->pos = es; complete_send(ee); assert(es == ee->pos); break; } object_decref(&es->executed); es--; }; } assert(es >= ee->execution_stack); break; case exp_primitive: #ifdef GPROF_HOOKS asm("gP_ExpPrim:"); #endif switch (optop[-1].type) { case fixed_type: optop[-1].value.real = floatfr(optop[-1].value.fixed); break; case real_type: break; default: goto typecheck_error; } switch (optop[-2].type) { case fixed_type: optop[-2].value.real = floatfr(optop[-2].value.fixed); optop[-2].type = real_type; break; case real_type: break; default: goto typecheck_error; } optop[-2].value.real = pow(optop[-2].value.real, optop[-1].value.real); optop--; break; case false_primitive: #ifdef GPROF_HOOKS asm("gP_FalsePrim:"); #endif new.value.fixed = fracti(0); goto boolean_result; case file_primitive: #ifdef GPROF_HOOKS asm("gP_FilePrim:"); #endif if (optop[-1].type != string_type || optop[-2].type != string_type) goto typecheck_error; errno = 0; new = open_file(body_of(&optop[-2])->body.string.chars + optop[-2].value.substring.start, optop[-2].value.substring.length, body_of(&optop[-1])->body.string.chars); if (new.type == null_type) { extern char *sys_errlist[]; object_decref(&new); if (errno) ee->error_detail = sys_errlist[errno]; goto undefinedfilename_error; } goto typed_result; case fill_primitive: #ifdef GPROF_HOOKS asm("gP_FillPrim:"); #endif cs_fill(&ee->gontext); break; case floor_primitive: #ifdef GPROF_HOOKS asm("gP_FloorPrim:"); #endif switch (optop[-1].type) { case real_type: optop[-1].value.real = floor(optop[-1].value.real); break; case fixed_type: optop[-1].value.fixed = fracti(floorfr(optop[-1].value.fixed)); break; default: goto typecheck_error; } break; case flushfile_primitive: #ifdef GPROF_HOOKS asm("gP_FlushfPrim:"); #endif if (optop[-1].type != file_type) goto typecheck_error; { register PSFILE *f = body_of(optop - 1)->body.file.outbuf; if (f) { if (psio_error(f)) goto ioerror_error; psio_flush(f); } } goto no_result; case flush_primitive: { register PSFILE *psf = ee->stdprnt->body.file.outbuf; #ifdef GPROF_HOOKS asm("gP_FlushPrim:"); #endif if (psf == 0 || psio_error(psf)) goto ioerror_error; psio_flush(psf); } break; case forall_primitive: #ifdef GPROF_HOOKS asm("gP_ForallPrim:"); #endif if (optop[-2].type != array_type && optop[-2].type != dictionary_type && optop[-2].type != string_type && (dict_table[(int) optop[-2].type] == 0 || body_of(optop-2) == 0)) goto typecheck_error; if (es >= ee->limit) goto stack_overflow; es++; es->type = forall_execution; es->executed = optop[-1]; es->env.forall = optop[-2]; if (dict_table[(int) optop[-2].type]) { es->env.forall.value.substring.start = 0; es->env.forall.value.substring.length = dict_table[(int) optop[-2].type]->body.array.size; } if (es->env.forall.type == dictionary_type) es->env.forall.value.substring.length = 1; optop -= 2; break; case for_primitive: #ifdef GPROF_HOOKS asm("gP_ForPrim:"); #endif if (optop[-4].type == fixed_type && optop[-3].type == fixed_type && optop[-2].type == fixed_type) { if (es >= ee->limit) goto stack_overflow; es++; es->type = fixed_for_execution; es->env.ifor.initial = optop[-4].value.fixed - optop[-3].value.fixed; es->env.ifor.increment = optop[-3].value.fixed; es->env.ifor.limit = optop[-2].value.fixed; es->env.ifor.stackpos = 1; } else { if (optop[-4].type == fixed_type) optop[-4].value.real = floatfr(optop[-4].value.fixed); else if (optop[-4].type != real_type) goto typecheck_error; if (optop[-3].type == fixed_type) optop[-3].value.real = floatfr(optop[-3].value.fixed); else if (optop[-3].type != real_type) goto typecheck_error; if (optop[-2].type == fixed_type) optop[-2].value.real = floatfr(optop[-2].value.fixed); else if (optop[-2].type != real_type) goto typecheck_error; if (es >= ee->limit) goto stack_overflow; es++; es->type = real_for_execution; es->env.rfor.initial = optop[-4].value.real - optop[-3].value.real; es->env.rfor.increment = optop[-3].value.real; es->env.rfor.limit = optop[-2].value.real; } es->executed = optop[-1]; optop -= 4; break; case fork_primitive: { register struct execution_environment *ne = create_process(); #ifdef GPROF_HOOKS asm("gP_ForkPrim:"); #endif { /* Copy the "send" entries in the execution stack */ register struct execution_stack *ses, *des; des = ne->execution_stack; for (ses = ee->execution_stack; ses <= es; ses++) if (ses->type == send_execution) { *des = *ses; object_incref(&des->executed); des++; } des->executed = optop[-1]; des->type = undetermined_execution; ne->pos = des; } { /* Copy the dictionary stack */ register struct dictstack_ent *cur; if (!have_dict_space(ne, ee->dict_top-ee->dictionary_stack)) goto handle_error; for (cur = ee->dictionary_stack; ++cur < ee->dict_top;) { if (cur->obj) { incref(cur->obj); } else incref(cur->body); *ne->dict_top++ = *cur; } } assert(ne->dict_top <= ne->dict_limit); { /* Copy the operand stack */ register struct object *cur; register needed = (optop - ee->underflow) - (ne->optop - ne->underflow); if (needed >= 0) grow_stack(ne, needed + 1); for (cur = ee->underflow; cur < optop - 1; cur++) { object_incref(cur); *ne->optop++ = *cur; } } cs_copy_context(&ee->gontext, &ne->gontext); ne->pgnext = ee->pgnext; ne->pgprev = ee; ee->pgnext->pgprev = ne; ee->pgnext = ne; decref(ne->stdprnt); ne->stdprnt = ee->stdprnt; incref(ne->stdprnt); decref(ne->stddiag); ne->stddiag = ee->stddiag; ne->detail_desired = ee->detail_desired; incref(ne->stddiag); ne->autobind = ee->autobind; set_typed_bodied_object(optop - 1, process_type, ne->body_handle); } break; case getinterval_primitive: #ifdef GPROF_HOOKS asm("gP_GetintvlPrim:"); #endif if ((optop[-3].type != array_type && optop[-3].type != string_type) || optop[-2].type != fixed_type || optop[-1].type != fixed_type) goto typecheck_error; if (optop[-2].value.fixed < 0 || optop[-1].value.fixed < 0 || roundfr(optop[-1].value.fixed) > optop[-3].value.substring.length - roundfr(optop[-2].value.fixed)) goto rangecheck_error; optop[-3].value.substring.length = roundfr(optop[-1].value.fixed); optop[-3].value.substring.start = optop[-3].value.substring.start + roundfr(optop[-2].value.fixed); optop -= 2; break; case get_primitive: #ifdef GPROF_HOOKS asm("gP_GetPrim:"); #endif switch (optop[-2].type) { case array_type: if (optop[-1].type != fixed_type) goto typecheck_error; if (optop[-1].value.fixed < 0 || roundfr(optop[-1].value.fixed) >= optop[-2].value.subarray.length) goto rangecheck_error; new = body_of(&optop[-2])->body.array.objects[ roundfr(optop[-1].value.fixed) + optop[-2].value.substring.start]; object_incref(&new); break; case string_type: if (optop[-1].type != fixed_type) goto typecheck_error; if (optop[-1].value.fixed < 0 || roundfr(optop[-1].value.fixed) >= optop[-2].value.substring.length) goto rangecheck_error; new.value.fixed = fracti((unsigned char) body_of(&optop[-2])->body.string.chars[ roundfr(optop[-1].value.fixed) + optop[-2].value.substring.start]); goto fixed_result; case dictionary_type: { register struct object *ret; if (optop[-1].type == string_type) convert_string_to_name(optop - 1); ret = find_object_in_dictionary(optop[-1], body_of(&optop[-2])); if (ret == 0) goto undefined_error; new = *ret; object_incref(&new); } break; default: { register struct body *dict = dict_table[(int) optop[-2].type]; register struct object *ret; if (dict == 0 || body_of(optop - 2) == 0) goto typecheck_error; if (optop[-1].type == string_type) convert_string_to_name(optop - 1); ret = find_object_in_dictionary(optop[-1], dict); if (ret == 0) goto undefined_error; if (ret->type == magic_variable_type) { ee->optop = optop; ee->pos = es; (*ret->value.def->function) (body_of(optop - 2), GET_MAGIC(ret->value.def->index)); if (ee->error_code) goto handle_error; if (ee->optop != optop + 1) { optop = ee->optop; error(unregistered); } new = *optop; } else { new = *ret; object_incref(&new); } } break; } goto typed_result; case ge_primitive: #ifdef GPROF_HOOKS asm("gP_GePrim:"); #endif compare_primitive(3); case grestoreall_primitive: #ifdef GPROF_HOOKS asm("gP_GrestallPrim:"); #endif cs_grestoreall(&ee->gontext); break; case grestore_primitive: #ifdef GPROF_HOOKS asm("gP_GrestPrim:"); #endif if (cs_grestore(&ee->gontext) < 0) goto stack_underflow; break; case gsave_primitive: #ifdef GPROF_HOOKS asm("gP_GsavePrim:"); #endif cs_gsave(&ee->gontext); break; case gt_primitive: #ifdef GPROF_HOOKS asm("gP_GtPrim:"); #endif compare_primitive(1); case idiv_primitive: #ifdef GPROF_HOOKS asm("gP_IdivPrim:"); #endif switch (object_type_pair(optop[-2], optop[-1])) { case tp(fixed, fixed): fract_overflows = 0; { register fract temp = vfrdiv(optop[-2].value.fixed, optop[-1].value.fixed); if (fract_overflows == 0) { if (temp >= 0) optop[-2].value.fixed = fracti(floorfr(temp)); else optop[-2].value.fixed = -fracti(floorfr(-temp)); optop--; break; } } optop[-1].value.real = floatfr(optop[-1].value.fixed); case tp(fixed, real): optop[-2].value.real = floatfr(optop[-2].value.fixed); goto do_real_idiv; case tp(real, fixed): optop[-1].value.real = floatfr(optop[-1].value.fixed); case tp(real, real): do_real_idiv: { register temp = (int) (optop[-2].value.real / optop[-1].value.real); if (-(1 << 15) < temp && temp < (1 << 15)) { optop[-2].value.fixed = fracti(temp); optop[-2].type = fixed_type; } else { optop[-2].value.real = temp; optop[-2].type = real_type; } } optop--; break; default: goto typecheck_error; } break; case idtransform_primitive: #ifdef GPROF_HOOKS asm("gP_IdtransPrim:"); #endif switch (object_type_pair(optop[-2], optop[-1])) { case tp(fixed, fixed): cs_fridtransform(&ee->gontext, optop[-2].value.fixed, optop[-1].value.fixed, &optop[-2].value.fixed, &optop[-1].value.fixed); break; case tp(fixed, real): cs_flidtransform(&ee->gontext, floatfr(optop[-2].value.fixed), optop[-1].value.real, &optop[-2].value.real, &optop[-1].value.real); set_typed_object(optop - 2, real_type); break; case tp(real, fixed): cs_flidtransform(&ee->gontext, optop[-2].value.real, floatfr(optop[-1].value.fixed), &optop[-2].value.real, &optop[-1].value.real); set_typed_object(optop - 1, real_type); break; case tp(real, real): cs_flidtransform(&ee->gontext, optop[-2].value.real, optop[-1].value.real, &optop[-2].value.real, &optop[-1].value.real); break; default: goto typecheck_error; } break; case ifelse_primitive: #ifdef GPROF_HOOKS asm("gP_IfelsePrim:"); #endif if (optop[-3].type != boolean_type) goto typecheck_error; if (optop[-3].value.fixed) { ee->execee = optop[-2]; object_decref(optop - 1); } else { ee->execee = optop[-1]; object_decref(optop - 2); } optop -= 3; goto execute_top; case if_primitive: #ifdef GPROF_HOOKS asm("gP_IfPrim:"); #endif if (optop[-2].type != boolean_type) goto typecheck_error; optop -= 2; if (optop[0].value.fixed) { ee->execee = optop[1]; goto execute_top; } else object_decref(optop + 1); break; case index_primitive: #ifdef GPROF_HOOKS asm("gP_IndexPrim:"); #endif if (optop[-1].type == fixed_type) { register n = roundfr(optop[-1].value.fixed); register struct object *p = optop - (2 + n); if (p < ee->underflow) { error(stackunderflow); } else if (n < 0) { error(rangecheck); } else { optop[-1] = *p; object_incref(optop - 1); } } else { typecheck_error: error(typecheck); } break; case initclip_primitive: #ifdef GPROF_HOOKS asm("gP_InitclpPrim:"); #endif cs_initclip(&ee->gontext); break; case initgraphics_primitive: #ifdef GPROF_HOOKS asm("gP_InitgrphPrim:"); #endif cs_initgraphics(&ee->gontext); break; case initmatrix_primitive: #ifdef GPROF_HOOKS asm("gP_InitmatPrim:"); #endif cs_initmatrix(&ee->gontext); break; case awaitevent_primitive: #ifdef GPROF_HOOKS asm("gP_AwaitPrim:"); #endif read_19: { register struct body *e; #ifdef GPROF_HOOKS asm("gP_RstrtAwtPrim:"); #endif if (ee->eq_head == NULL) { /* 0 events in queue */ if (ee->interests == NULL) error(invalidaccess); ee->event = input_event_wait; ee->restart_state = 19; goto suspend_process; } set_typed_bodied_object(optop, event_type, ee->eq_head); e = body_of(optop); optop++; if (ee->eq_tail == ee->eq_head) { /* 1 event in queue */ ee->eq_head = NULL; ee->eq_tail = NULL; } else { /* >1 events in queue */ ee->eq_head = ee->eq_head->body.event.next; } if (e->body.event.runnable_match.type != null_type) { ee->execee = e->body.event.runnable_match; clear_object(&e->body.event.runnable_match); goto execute_top; } break; } case itransform_primitive: #ifdef GPROF_HOOKS asm("gP_ItransPrim:"); #endif switch (object_type_pair(optop[-2], optop[-1])) { case tp(fixed, fixed): cs_fritransform(&ee->gontext, optop[-2].value.fixed, optop[-1].value.fixed, &optop[-2].value.fixed, &optop[-1].value.fixed); break; case tp(fixed, real): cs_flitransform(&ee->gontext, floatfr(optop[-2].value.fixed), optop[-1].value.real, &optop[-2].value.real, &optop[-1].value.real); set_typed_object(optop - 2, real_type); break; case tp(real, fixed): cs_flitransform(&ee->gontext, optop[-2].value.real, floatfr(optop[-1].value.fixed), &optop[-2].value.real, &optop[-1].value.real); set_typed_object(optop - 1, real_type); break; case tp(real, real): cs_flitransform(&ee->gontext, optop[-2].value.real, optop[-1].value.real, &optop[-2].value.real, &optop[-1].value.real); break; default: goto typecheck_error; } break; case known_primitive: #ifdef GPROF_HOOKS asm("gP_KnownPrim:"); #endif if (optop[-1].type == string_type) convert_string_to_name(optop - 1); switch (optop[-2].type) { case dictionary_type: new.value.fixed = fracti(find_object_in_dictionary(optop[-1], body_of(&optop[-2])) != 0); break; default:{ register struct body *knownbody; knownbody = dict_table[(int) optop[-2].type]; if (knownbody == 0 || body_of(optop - 2) == 0) goto typecheck_error; new.value.fixed = fracti(find_object_in_dictionary(optop[-1], knownbody) != 0); break; } } goto boolean_result; case length_primitive: #ifdef GPROF_HOOKS asm("gP_LenPrim:"); #endif switch (optop[-1].type) { case array_type: case string_type: new.value.fixed = fracti(optop[-1].value.substring.length); goto fixed_result; default: { register struct body *dictbod; dictbod = (optop[-1].type == dictionary_type) ? body_of(optop - 1) : dict_table[(int) optop[-1].type]; if (dictbod == 0 || body_of(optop - 1) == 0) goto typecheck_error; new.value.fixed = fracti(dictbod->body.array.used / 2); #ifdef DEBUG { /* TEMP testing! */ register struct object *p = dictbod->body.array.objects; register n = dictbod->body.array.size / 2; int i = 0; while (--n >= 0) { if (p->type != null_type) i++; p += 2; } assert(roundfr(new.value.fixed) == i); } #endif goto fixed_result; } } case le_primitive: #ifdef GPROF_HOOKS asm("gP_LePrim:"); #endif compare_primitive(6); case lineto_primitive: #ifdef GPROF_HOOKS asm("gP_LinetoPrim:"); #endif if (!cs_hascurrentpoint(&ee->gontext)) goto nocurrentpoint_error; switch (object_type_pair(optop[-2], optop[-1])) { case tp(fixed, fixed): #ifdef GPROF_HOOKS asm("gP_LineFixFix:"); #endif cs_frlineto(&ee->gontext, optop[-2].value.fixed, optop[-1].value.fixed); break; case tp(fixed, real): #ifdef GPROF_HOOKS asm("gP_LineFixReal:"); #endif cs_fllineto(&ee->gontext, floatfr(optop[-2].value.fixed), optop[-1].value.real); break; case tp(real, fixed): #ifdef GPROF_HOOKS asm("gP_LineRealFix:"); #endif cs_fllineto(&ee->gontext, optop[-2].value.real, floatfr(optop[-1].value.fixed)); break; case tp(real, real): #ifdef GPROF_HOOKS asm("gP_LineRealReal:"); #endif cs_fllineto(&ee->gontext, optop[-2].value.real, optop[-1].value.real); break; default: goto typecheck_error; } optop -= 2; break; case ln_primitive: #ifdef GPROF_HOOKS asm("gP_LnPrim:"); #endif switch (optop[-1].type) { case fixed_type: optop[-1].value.fixed = fractf(log(floatfr(optop[-1].value.fixed))); break; case real_type: optop[-1].type = fixed_type; optop[-1].value.fixed = fractf(log(optop[-1].value.real)); break; default: goto typecheck_error; } break; case load_primitive: { register struct dictstack_ent *stackent = ee->dict_top; register hash; #ifdef GPROF_HOOKS asm("gP_LoadPrim:"); #endif if (optop[-1].type == string_type) convert_string_to_name(optop - 1); hash_object(hash, &optop[-1]); while (--stackent >= ee->dictionary_stack) { register struct object *ret = &stackent->body->body.array.objects[ hash_index(hash, stackent->body->body.array.size >> 1)]; while (ret->type != null_type) { if (equal_object(ret, &optop[-1])) { object_decref(&optop[-1]); object_incref(&ret[1]); optop[-1] = ret[1]; goto finished_result; } ret -= 2; if (ret < stackent->body->body.array.objects) ret = &stackent->body->body.array.objects[stackent->body->body.array.size - 2]; } } } goto undefined_error; case log_primitive: #ifdef GPROF_HOOKS asm("gP_LogPrim:"); #endif switch (optop[-1].type) { case fixed_type: optop[-1].value.fixed = fractf(log10(floatfr(optop[-1].value.fixed))); break; case real_type: optop[-1].type = fixed_type; optop[-1].value.fixed = fractf(log10(optop[-1].value.real)); break; default: goto typecheck_error; } break; case loop_primitive: #ifdef GPROF_HOOKS asm("gP_LoopPrim:"); #endif if (es >= ee->limit) goto stack_overflow; es++; es->type = fixed_for_execution; es->env.ifor.initial = 0; es->env.ifor.increment = 0; es->env.ifor.limit = 1; es->env.ifor.stackpos = 0; es->executed = optop[-1]; optop--; break; case lt_primitive: #ifdef GPROF_HOOKS asm("gP_LtPrim:"); #endif compare_primitive(4); case mark_primitive: #ifdef GPROF_HOOKS asm("gP_MarkPrim:"); #endif new.type = marker_type; goto typed_result; case max_primitive: { register ret; #ifdef GPROF_HOOKS asm("gP_MaxPrim:"); #endif if ((ret = PerformCompare(optop[-2], optop[-1])) < 0) goto typecheck_error; if ((ret & 1) == 0) { object_decref(optop - 2); optop[-2] = optop[-1]; } else object_decref(optop - 1); optop--; } break; case maxlength_primitive: { struct body *maxbod; int n; #ifdef GPROF_HOOKS asm("gP_MaxlenPrim:"); #endif if (optop[-1].type == dictionary_type) { n = body_of(optop - 1)->body.array.max_size; } else if (maxbod = dict_table[(int) optop[-1].type]) { n = maxbod->body.array.size; } else { goto typecheck_error; } object_decref(optop - 1); set_fixed_object(optop - 1, fracti(n >> 1)); } break; case min_primitive: { register ret; #ifdef GPROF_HOOKS asm("gP_MinPrim:"); #endif if ((ret = PerformCompare(optop[-2], optop[-1])) < 0) goto typecheck_error; if ((ret & 1) != 0) { object_decref(optop - 2); optop[-2] = optop[-1]; } else object_decref(optop - 1); optop--; } break; case mod_primitive: #ifdef GPROF_HOOKS asm("gP_ModPrim:"); #endif if (optop[-1].type != fixed_type || optop[-2].type != fixed_type) goto typecheck_error; if (optop[-1].value.fixed == 0) goto undefinedresult_error; optop[-2].value.fixed = fracti(cfloorfr(optop[-2].value.fixed) % cfloorfr(optop[-1].value.fixed)); optop--; break; case monitor_primitive: #ifdef GPROF_HOOKS asm("gP_MonitorPrim:"); #endif if (optop[-2].type != monitor_type) goto typecheck_error; if (es >= ee->limit) goto stack_overflow; es++; es->type = monitor_execution; es->executed = optop[-1]; es->env.monitor = optop[-2]; es->env.monitor.executable = 0; /* used to flag whether or not the * monitor has been entered yet */ optop -= 2; break; case moveto_primitive: #ifdef GPROF_HOOKS asm("gP_MovetoPrim:"); #endif switch (object_type_pair(optop[-2], optop[-1])) { case tp(fixed, fixed): cs_frmoveto(&ee->gontext, optop[-2].value.fixed, optop[-1].value.fixed); break; case tp(fixed, real): cs_flmoveto(&ee->gontext, floatfr(optop[-2].value.fixed), optop[-1].value.real); break; case tp(real, fixed): cs_flmoveto(&ee->gontext, optop[-2].value.real, floatfr(optop[-1].value.fixed)); break; case tp(real, real): cs_flmoveto(&ee->gontext, optop[-2].value.real, optop[-1].value.real); break; default: goto typecheck_error; } optop -= 2; break; case mul_primitive: #ifdef GPROF_HOOKS asm("gP_MulPrim:"); #endif binary_primitive(*, vfrmul); break; case neg_primitive: #ifdef GPROF_HOOKS asm("gP_NegPrim:"); #endif switch (optop[-1].type) { case real_type: optop[-1].value.real = -optop[-1].value.real; break; case fixed_type: optop[-1].value.fixed = -optop[-1].value.fixed; break; default: goto typecheck_error; } break; case newpath_primitive: #ifdef GPROF_HOOKS asm("gP_NewpathPrim:"); #endif cs_newpath(&ee->gontext); break; case ne_primitive: #ifdef GPROF_HOOKS asm("gP_NePrim:"); #endif if (!equal_object(optop - 2, optop - 1) && PerformCompare(optop[-2], optop[-1]) != 2) new.value.fixed = F1; goto boolean_result; case not_primitive: #ifdef GPROF_HOOKS asm("gP_NotPrim:"); #endif switch (optop[-1].type) { case fixed_type: optop[-1].value.fixed = ~optop[-1].value.fixed; break; case boolean_type: optop[-1].value.fixed = optop[-1].value.fixed ^ F1; break; default: goto typecheck_error; } break; case null_primitive: #ifdef GPROF_HOOKS asm("gP_NullPrim:"); #endif new.type = null_type; goto typed_result; case or_primitive: #ifdef GPROF_HOOKS asm("gP_OrPrim:"); #endif boolean_binary_primitive(|); case pathbbox_primitive: #ifdef GPROF_HOOKS asm("gP_PathbbPrim:"); #endif cs_pathbbox(&ee->gontext, &optop[0].value.fixed, &optop[1].value.fixed, &optop[2].value.fixed, &optop[3].value.fixed); set_typed_object(&optop[0], fixed_type); set_typed_object(&optop[1], fixed_type); set_typed_object(&optop[2], fixed_type); set_typed_object(&optop[3], fixed_type); optop += 4; break; case pathforallvec_primitive: #ifdef GPROF_HOOKS asm("gP_PathfavPrim:"); #endif if (optop[-1].type != array_type) goto typecheck_error; if (optop[-1].value.substring.length < 4 || ee->gontext.path.startpos >= ee->gontext.path.used && ee->gontext.shape != 0) error(invalidaccess); if (es >= ee->limit) goto stack_overflow; es++; if (optop[-1].value.substring.length <= 4 && !ee->gontext.path.straight) cs_flattenpath(&ee->gontext); es->type = pathforall_execution; es->env.pathforall.pos = ee->gontext.path.startpos; es->env.pathforall.end = ee->gontext.path.used; es->env.pathforall.bottom = ee->gontext.path.bottompos; es->env.pathforall.lastop = CLOSEPATH_FLAG; ee->gontext.path.bottompos = ee->gontext.path.used; es->executed = optop[-1]; optop--; break; case pause_primitive: #ifdef GPROF_HOOKS asm("gP_PausePrim:"); #endif ee->restart_state = 0; goto suspend_process; case exitloop_primitive: #ifdef GPROF_HOOKS asm("gP_ExitlPrim:"); #endif #ifdef PREVIEW return (-1); #else goto unimplemented_primitive; #endif case print_primitive: #ifdef GPROF_HOOKS asm("gP_PrintPrim:"); #endif if (optop[-1].type != string_type) goto typecheck_error; { register PSFILE *f = ee->stdprnt->body.file.outbuf; register char *s = body_of(optop - 1)->body.string.chars + optop[-1].value.substring.start; register n = optop[-1].value.substring.length; if (f == 0 || psio_error(f)) goto ioerror_error; while (--n >= 0) psio_putc(*s++, f); } goto no_result; case put_primitive: #ifdef GPROF_HOOKS asm("gP_PutPrim:"); #endif if (!object_has_body(optop - 3)) goto typecheck_error; { register struct body *b = body_of(optop - 3); if (b->readonly) error(invalidaccess); switch (optop[-3].type) { case array_type: { register struct object *slot; if (optop[-2].type != fixed_type) goto typecheck_error; if (optop[-2].value.fixed < 0 || roundfr(optop[-2].value.fixed) >= optop[-3].value.subarray.length) goto rangecheck_error; slot = &b->body.array.objects[roundfr(optop[-2].value.fixed) + optop[-3].value.subarray.start]; object_decref(slot); *slot = optop[-1]; } break; case string_type: if (optop[-2].type != fixed_type || optop[-1].type != fixed_type) goto typecheck_error; if (optop[-2].value.fixed < 0 || roundfr(optop[-2].value.fixed) >= optop[-3].value.substring.length) goto rangecheck_error; b->body.string.chars[roundfr(optop[-2].value.fixed) + optop[-3].value.substring.start] = roundfr(optop[-1].value.fixed); break; case dictionary_type: if (optop[-2].type == string_type) convert_string_to_name(optop - 2); define_object_in_dictionary(optop[-2], optop[-1], b, 0); if (ee->error_code) goto handle_error; object_decref(optop - 2); break; default: { register struct body *dict = dict_table[(int) optop[-3].type]; register struct object *ret; if (dict == 0) goto typecheck_error; if (dict->readonly || body_of(optop - 3) == 0) error(invalidaccess); if (optop[-2].type == string_type) convert_string_to_name(optop - 2); define_object_in_dictionary(optop[-2], optop[-1], dict, b); if (ee->error_code) goto handle_error; object_decref(optop - 2); } break; } decref(b); optop -= 3; } break; case quit_primitive: #ifdef GPROF_HOOKS asm("gP_QuitPrim:"); #endif do_quit_primitive: #ifdef GPROF_HOOKS asm("gP_DoQuit:"); #endif while (es >= ee->execution_stack) { switch (es->type) { case forall_execution: object_decref(&es->env.forall); break; case monitor_execution: disentangle_monitor(ee, body_of(&es->env.monitor)); break; case buildimage_execution: pr_destroy(es->env.image.image); break; case send_execution: ee->pos = es; complete_send(ee); assert(es == ee->pos); break; case file_execution:{ register PSFILE *clf = ee->stdprnt->body.file.outbuf; if (selectable_file(psio_fileno(es->env.file.file), 1)) remove_selectable_file(psio_fileno(es->env.file.file), 1); if (clf && clf->file == es->env.file.file->file) psio_nodropclose(clf); psio_nodropclose(es->env.file.file); } break; } object_decref(&es->executed); es--; }; goto suspend_process; case random_primitive: #ifdef GPROF_HOOKS asm("gP_RandPrim:"); #endif set_fixed_object(optop, random() & 0xFFFF); optop++; break; case rcontrolpoint_primitive: { fract variation; #ifdef GPROF_HOOKS asm("gP_RctrlpntPrim:"); #endif if (optop[-1].type == fixed_type) variation = optop[-1].value.fixed; else if (optop[-1].type == real_type) variation = fractf(optop[-1].value.real); else goto typecheck_error; switch (object_type_pair(optop[-3], optop[-2])) { case tp(fixed, fixed): cs_frrlineby(&ee->gontext, optop[-3].value.fixed, optop[-2].value.fixed, variation); break; case tp(fixed, real): cs_flrlineby(&ee->gontext, floatfr(optop[-3].value.fixed), optop[-2].value.real, variation); break; case tp(real, fixed): cs_flrlineby(&ee->gontext, optop[-3].value.real, floatfr(optop[-2].value.fixed), variation); break; case tp(real, real): cs_flrlineby(&ee->gontext, optop[-3].value.real, optop[-2].value.real, variation); break; default: goto typecheck_error; } } optop -= 3; break; case read_primitive: #ifdef GPROF_HOOKS asm("gP_ReadPrim:"); #endif if (optop[-1].type != file_type) goto typecheck_error; { register c; register PSFILE *psf = body_of(optop - 1)->body.file.inbuf; if (psf == 0 || psio_error(psf)) goto ioerror_error; pgetc(22, c, psf); object_decref(optop - 1); if (c == EOF) optop[-1].value.fixed = fracti(0); else { set_fixed_object(optop - 1, fracti(c)); optop++; optop[-1].value.fixed = fracti(1); } set_typed_object(optop - 1, boolean_type); } break; case readhexstring_primitive: #ifdef GPROF_HOOKS asm("gP_ReadhexPrim:"); #endif if (optop[-1].type != string_type || optop[-2].type != file_type) goto typecheck_error; optop[-1].value.substring.start = 0; { register c; while (optop[-1].value.substring.length > 0) { pgetc(23, c, body_of(optop - 2)->body.file.inbuf); if (c == EOF) break; c = translate_digit[c]; if (c >= 16) continue; if (optop[-1].value.substring.start & 1) { optop[-1].value.substring.length--; body_of(optop - 1)->body.string.chars[optop[-1].value.substring.start >> 1] |= c; } else body_of(optop - 1)->body.string.chars[optop[-1].value.substring.start >> 1] = c << 4; optop[-1].value.substring.start++; } optop[-1].value.substring.length = (optop[-1].value.substring.start + 1) >> 1; optop[-1].value.substring.start = 0; object_decref(optop - 2); optop[-2] = optop[-1]; set_typed_object(optop - 1, boolean_type); optop[-1].value.fixed = c == EOF ? fracti(0) : F1; } break; case readline_primitive: #ifdef GPROF_HOOKS asm("gP_ReadlnPrim:"); #endif if (optop[-1].type != string_type || optop[-2].type != file_type) goto typecheck_error; optop[-1].value.substring.start = 0; { register c; while (optop[-1].value.substring.length > 0) { optop[-1].value.substring.length--; pgetc(12, c, body_of(&optop[-2])->body.file.inbuf); if (c == EOF || c == '\n') break; body_of(optop - 1)->body.string.chars[optop[-1].value.substring.start++] = c; } optop[-1].value.substring.length = optop[-1].value.substring.start; optop[-1].value.substring.start = 0; object_decref(optop - 2); optop[-2] = optop[-1]; set_typed_object(optop - 1, boolean_type); optop[-1].value.fixed = c == EOF ? fracti(0) : F1; } break; case readonly_primitive: #ifdef GPROF_HOOKS asm("gP_ReadonlPrim:"); #endif if (object_has_body(optop - 1)) body_of(optop - 1)->readonly = 1; /* * readonly takes a single arg and leaves the same arg so don't * touch the stack. */ goto finished_result; case readstring_primitive: #ifdef GPROF_HOOKS asm("gP_ReadstrPrim:"); #endif if (optop[-1].type != string_type || optop[-2].type != file_type) goto typecheck_error; optop[-1].value.substring.start = 0; { register c; while (optop[-1].value.substring.length > 0) { optop[-1].value.substring.length--; pgetc(13, c, body_of(&optop[-2])->body.file.inbuf); if (c == EOF) break; body_of(optop - 1)->body.string.chars[optop[-1].value.substring.start++] = c; } optop[-1].value.substring.length = optop[-1].value.substring.start; optop[-1].value.substring.start = 0; object_decref(optop - 2); optop[-2] = optop[-1]; set_typed_object(optop - 1, boolean_type); optop[-1].value.fixed = c == EOF ? fracti(0) : F1; } break; case repeat_primitive: #ifdef GPROF_HOOKS asm("gP_RepeatPrim:"); #endif if (optop[-2].type != fixed_type) goto typecheck_error; if (es >= ee->limit) goto stack_overflow; es++; es->type = fixed_for_execution; es->env.ifor.initial = fracti(0); es->env.ifor.increment = F1; es->env.ifor.limit = optop[-2].value.fixed; es->env.ifor.stackpos = 0; es->executed = optop[-1]; optop -= 2; break; case rlineto_primitive: #ifdef GPROF_HOOKS asm("gP_RlinePrim:"); #endif if (!cs_hascurrentpoint(&ee->gontext)) goto nocurrentpoint_error; switch (object_type_pair(optop[-2], optop[-1])) { case tp(fixed, fixed): cs_frrlineto(&ee->gontext, optop[-2].value.fixed, optop[-1].value.fixed); break; case tp(fixed, real): cs_flrlineto(&ee->gontext, floatfr(optop[-2].value.fixed), optop[-1].value.real); break; case tp(real, fixed): cs_flrlineto(&ee->gontext, optop[-2].value.real, floatfr(optop[-1].value.fixed)); break; case tp(real, real): cs_flrlineto(&ee->gontext, optop[-2].value.real, optop[-1].value.real); break; default: goto typecheck_error; } optop -= 2; break; case rmoveto_primitive: #ifdef GPROF_HOOKS asm("gP_RmovePrim:"); #endif if (!cs_hascurrentpoint(&ee->gontext)) goto nocurrentpoint_error; switch (object_type_pair(optop[-2], optop[-1])) { case tp(fixed, fixed): cs_frrmoveto(&ee->gontext, optop[-2].value.fixed, optop[-1].value.fixed); break; case tp(fixed, real): cs_flrmoveto(&ee->gontext, floatfr(optop[-2].value.fixed), optop[-1].value.real); break; case tp(real, fixed): cs_flrmoveto(&ee->gontext, optop[-2].value.real, floatfr(optop[-1].value.fixed)); break; case tp(real, real): cs_flrmoveto(&ee->gontext, optop[-2].value.real, optop[-1].value.real); break; default: goto typecheck_error; } optop -= 2; break; case roll_primitive: #ifdef GPROF_HOOKS asm("gP_RollPrim:"); #endif if (optop[-1].type != fixed_type || optop[-2].type != fixed_type) goto typecheck_error; else { register n = roundfr(optop[-2].value.fixed); register j = roundfr(optop[-1].value.fixed); if (j > n) j = j % n; while (j < 0) j += n; optop -= 2; if (n > 1 && j) { if (optop < ee->underflow + n) goto stack_underflow; overflow_check(n - j); bcopy(&optop[-n], optop, (n - j) * sizeof(struct object)); bcopy(&optop[-j], &optop[-n], n * sizeof(struct object)); } } break; case rotate_primitive: #ifdef GPROF_HOOKS asm("gP_RotPrim:"); #endif switch (optop[-1].type) { case fixed_type: cs_frrotate(&ee->gontext, optop[-1].value.fixed); break; case real_type: cs_frrotate(&ee->gontext, fractf(optop[-1].value.real)); break; case array_type:{ register struct object *p = result_matrix(optop[-1]); fract sinf, cosf; if (p == 0) goto typecheck_error; switch (optop[-2].type) { case fixed_type: frsincosd(optop[-2].value.fixed, &sinf, &cosf); break; case real_type: frsincosd(fractf(optop[-2].value.real), &sinf, &cosf); break; default: goto typecheck_error; } p[0].value.fixed = cosf; p[1].value.fixed = sinf; p[2].value.fixed = -sinf; p[3].value.fixed = cosf; p[4].value.fixed = fracti(0); p[5].value.fixed = fracti(0); optop[-2] = optop[-1]; break; } default: goto typecheck_error; } optop--; break; case round_primitive: #ifdef GPROF_HOOKS asm("gP_RoundPrim:"); #endif switch (optop[-1].type) { case real_type: optop[-1].value.real = (int) (optop[-1].value.real + 0.5); break; case fixed_type: optop[-1].value.fixed = fracti(roundfr(optop[-1].value.fixed)); break; default: goto typecheck_error; } break; case scale_primitive: #ifdef GPROF_HOOKS asm("gP_ScalePrim:"); #endif if (optop[-1].type == array_type) { register struct object *p = result_matrix(optop[-1]); if (p == 0) goto typecheck_error; if ((optop[-2].type != fixed_type && optop[-2].type != real_type) || (optop[-3].type != fixed_type && optop[-3].type != real_type)) goto typecheck_error; p[0] = optop[-3]; p[1].value.fixed = fracti(0); p[2].value.fixed = fracti(0); p[3] = optop[-2]; p[4].value.fixed = fracti(0); p[5].value.fixed = fracti(0); optop[-3] = optop[-1]; } else switch (object_type_pair(optop[-2], optop[-1])) { case tp(fixed, fixed): cs_frscale(&ee->gontext, optop[-2].value.fixed, optop[-1].value.fixed); break; case tp(fixed, real): cs_flscale(&ee->gontext, floatfr(optop[-2].value.fixed), optop[-1].value.real); break; case tp(real, fixed): cs_flscale(&ee->gontext, optop[-2].value.real, floatfr(optop[-1].value.fixed)); break; case tp(real, real): cs_flscale(&ee->gontext, optop[-2].value.real, optop[-1].value.real); break; default: goto typecheck_error; } optop -= 2; break; case scalefont_primitive: #ifdef GPROF_HOOKS asm("gP_ScalefntPrim:"); #endif if (optop[-2].type != font_id_type) goto typecheck_error; { register struct body *b = body_of(optop - 2); register struct psfont *f; register fract scale; switch (optop[-1].type) { case fixed_type: scale = optop[-1].value.fixed; break; case real_type: scale = fracti(optop[-1].value.real); break; default: goto typecheck_error; } f = cs_frscalefont(b->body.font, scale); decref(b); b = new_body(font); optop--; set_typed_bodied_object(optop - 1, font_id_type, b); b->type = font_id_type; b->body.font = f; } break; case setcanvas_primitive: #ifdef GPROF_HOOKS asm("gP_SetcanPrim:"); #endif if (optop[-1].type != canvas_type) goto typecheck_error; cs_setcanvas(&ee->gontext, optop[-1].value.canvas); decref(body_of(optop - 1)); optop--; break; case setfont_primitive: #ifdef GPROF_HOOKS asm("gP_SetfntPrim:"); #endif if (optop[-1].type != font_id_type) goto typecheck_error; { register struct body *b = body_of(optop - 1); cs_setfont(&ee->gontext, b->body.font); decref(b); optop--; } break; case setgray_primitive: #ifdef GPROF_HOOKS asm("gP_SetgryPrim:"); #endif switch (optop[-1].type) { case fixed_type: cs_frsetgray(&ee->gontext, optop[-1].value.fixed); break; case real_type: cs_frsetgray(&ee->gontext, fractf(optop[-1].value.real)); break; default: goto typecheck_error; } optop--; break; case setlinecap_primitive: { register enum cs_linecap cap; #ifdef GPROF_HOOKS asm("gP_SetlcapPrim:"); #endif switch (optop[-1].type) { case fixed_type: cap = (enum cs_linecap) floorfr(optop[-1].value.fixed); break; case real_type: cap = (enum cs_linecap) floorfr(fractf(optop[-1].value.real)); break; default: goto typecheck_error; } switch (cap) { case cs_buttcap: case cs_roundcap: case cs_squarecap: cs_setlinecap(&ee->gontext, cap); optop--; break; default: goto rangecheck_error; } } break; case setlinejoin_primitive: { register enum cs_linejoin join; #ifdef GPROF_HOOKS asm("gP_SetljoinPrim:"); #endif switch (optop[-1].type) { case fixed_type: join = (enum cs_linejoin) floorfr(optop[-1].value.fixed); break; case real_type: join = (enum cs_linejoin) floorfr(fractf(optop[-1].value.real)); break; default: goto typecheck_error; } switch (join) { case cs_miterjoin: case cs_roundjoin: case cs_beveljoin: cs_setlinejoin(&ee->gontext, join); optop--; break; default: goto rangecheck_error; } } break; case setlinewidth_primitive: #ifdef GPROF_HOOKS asm("gP_SetlwidPrim:"); #endif switch (optop[-1].type) { case fixed_type: cs_frsetlinewidth(&ee->gontext, optop[-1].value.fixed); break; case real_type: cs_frsetlinewidth(&ee->gontext, fractf(optop[-1].value.real)); break; default: goto typecheck_error; } optop--; break; case setmatrix_primitive: { fract matrix[6] /* [3][2] */ ; register struct object *p; register int i = 6; #ifdef GPROF_HOOKS asm("gP_SetmatPrim:"); #endif if (optop[-1].type != array_type || optop[-1].value.subarray.length < 6) goto typecheck_error; p = &body_of(&optop[-1])->body.array.objects[optop[-1].value.subarray.start]; while (i-- > 0) switch (p[i].type) { case fixed_type: matrix[i] = p[i].value.fixed; break; case real_type: matrix[i] = fractf(p[i].value.real); break; default: goto typecheck_error; } cs_setmatrix(&ee->gontext, matrix); } goto no_result; case setmiterlimit_primitive: #ifdef GPROF_HOOKS asm("gP_SetmiterPrim:"); #endif switch (optop[-1].type) { case fixed_type: cs_setmiterlimit(&ee->gontext, optop[-1].value.fixed); break; case real_type: cs_setmiterlimit(&ee->gontext, fractf(optop[-1].value.real)); break; default: goto typecheck_error; } optop--; break; case setprintermatch_primitive: #ifdef GPROF_HOOKS asm("gP_SetprntPrim:"); #endif if (optop[-1].type != boolean_type) goto typecheck_error; cs_setprintermatch(&ee->gontext, cfloorfr(optop[-1].value.fixed) & 1); optop--; break; case show_primitive: #ifdef GPROF_HOOKS asm("gP_ShowPrim:"); #endif if (optop[-1].type != string_type) goto typecheck_error; if (!cs_hascurrentpoint(&ee->gontext)) goto nocurrentpoint_error; ee->optop = optop; ee->pos = es; cs_cshow(&ee->gontext, body_of(optop - 1)->body.string.chars + optop[-1].value.substring.start, optop[-1].value.substring.length); es = ee->pos; optop = ee->optop; object_decref(optop - 1); optop--; break; case sin_primitive: { fract temp; #ifdef GPROF_HOOKS asm("gP_SinPrim:"); #endif if (optop[-1].type == fixed_type) frsincosd(optop[-1].value.fixed, &optop[-1].value.fixed, &temp); else if (optop[-1].type == real_type) { frsincosd(fractf(optop[-1].value.real), &optop[-1].value.fixed, &temp); optop[-1].type = fixed_type; } else goto typecheck_error; } break; case sqrt_primitive: #ifdef GPROF_HOOKS asm("gP_SqrtPrim:"); #endif if (optop[-1].type == fixed_type) optop[-1].value.fixed = frsqrt(optop[-1].value.fixed); else if (optop[-1].type == real_type) { optop[-1].value.real = sqrt(optop[-1].value.real); if (optop[-1].value.real < floatfr(FRHUGE)) { optop[-1].value.fixed = fractf(optop[-1].value.real); optop[-1].type = fixed_type; } } else goto typecheck_error; break; case stopped_primitive: #ifdef GPROF_HOOKS asm("gP_StoppedPrim:"); #endif if (es >= ee->limit) goto stack_overflow; es++; es->type = stopped_execution; es->executed.type = null_type; ee->execee = optop[-1]; optop--; goto execute_top; case stop_primitive: #ifdef GPROF_HOOKS asm("gP_StopPrim:"); #endif { register struct execution_stack *p = es; while (p >= ee->execution_stack) { if (p->type == stopped_execution) break; p--; } if (p < ee->execution_stack) p = ee->execution_stack; while (es >= p && (es->type != file_execution || p >= ee->execution_stack)) { switch (es->type) { case forall_execution: object_decref(&es->env.forall); break; case monitor_execution: disentangle_monitor(ee, body_of(&es->env.monitor)); break; case buildimage_execution: pr_destroy(es->env.image.image); break; case send_execution: ee->pos = es; complete_send(ee); assert(es == ee->pos); break; } object_decref(&es->executed); es--; }; if (es < ee->execution_stack) goto suspend_process; if (es >= p) break; } new.value.fixed = F1; goto boolean_result; case string_primitive: #ifdef GPROF_HOOKS asm("gP_StringPrim:"); #endif if (optop[-1].type != fixed_type) goto typecheck_error; { register string_size = roundfr(optop[-1].value.fixed); if (string_size < 0) goto rangecheck_error; optop[-1] = make_string(string_size, 0); } bzero(body_of(optop - 1)->body.string.chars, optop[-1].value.substring.length); break; case stringwidth_primitive: #ifdef GPROF_HOOKS asm("gP_StrwidPrim:"); #endif if (optop[-1].type != string_type) goto typecheck_error; ee->optop = optop; ee->pos = es; cs_frcstringwidth(&ee->gontext, body_of(optop - 1)->body.string.chars + optop[-1].value.substring.start, optop[-1].value.substring.length, &shape_point.x, &shape_point.y); optop = ee->optop; es = ee->pos; object_decref(optop - 1); set_fixed_object(optop - 1, shape_point.x); set_fixed_object(optop, shape_point.y); optop++; break; case stroke_primitive: #ifdef GPROF_HOOKS asm("gP_StrokePrim:"); #endif if (ee->gontext.texture[0]) cs_dashpath(&ee->gontext); if (cs_currentstrokequality(&ee->gontext) > 0) { extern struct object slow_stroke_handler_proc; ee->execee = slow_stroke_handler_proc; goto execute_top; } else cs_stroke(&ee->gontext); break; case sub_primitive: #ifdef GPROF_HOOKS asm("gP_SubPrim:"); #endif binary_primitive(-, vfrsub); break; case systemdict_primitive: #ifdef GPROF_HOOKS asm("gP_SysdictPrim:"); #endif set_typed_bodied_object(&new, dictionary_type, system_dictionary); incref(system_dictionary); goto typed_result; case token_primitive: #ifdef GPROF_HOOKS asm("gP_TokenPrim:"); #endif goto unimplemented_primitive; case transform_primitive: #ifdef GPROF_HOOKS asm("gP_TransformPrim:"); #endif switch (object_type_pair(optop[-2], optop[-1])) { case tp(fixed, fixed): cs_frtransform(&ee->gontext, optop[-2].value.fixed, optop[-1].value.fixed, &optop[-2].value.fixed, &optop[-1].value.fixed); break; case tp(fixed, real): cs_fltransform(&ee->gontext, floatfr(optop[-2].value.fixed), optop[-1].value.real, &optop[-2].value.fixed, &optop[-1].value.fixed); set_typed_object(optop - 1, fixed_type); break; case tp(real, fixed): cs_fltransform(&ee->gontext, optop[-2].value.real, floatfr(optop[-1].value.fixed), &optop[-2].value.fixed, &optop[-1].value.fixed); set_typed_object(optop - 2, fixed_type); break; case tp(real, real): cs_fltransform(&ee->gontext, optop[-2].value.real, optop[-1].value.real, &optop[-2].value.fixed, &optop[-1].value.fixed); set_typed_object(optop - 1, fixed_type); set_typed_object(optop - 2, fixed_type); break; default: goto typecheck_error; } break; case translate_primitive: /* this translation operator only works on the * CTM, it doesnt work on a general matrix * parameter */ #ifdef GPROF_HOOKS asm("gP_TranslatePrim:"); #endif switch (object_type_pair(optop[-2], optop[-1])) { case tp(fixed, fixed): cs_frtranslate(&ee->gontext, optop[-2].value.fixed, optop[-1].value.fixed); break; case tp(fixed, real): cs_fltranslate(&ee->gontext, floatfr(optop[-2].value.fixed), optop[-1].value.real); break; case tp(real, fixed): cs_fltranslate(&ee->gontext, optop[-2].value.real, floatfr(optop[-1].value.fixed)); break; case tp(real, real): cs_fltranslate(&ee->gontext, optop[-2].value.real, optop[-1].value.real); break; default: goto typecheck_error; } optop -= 2; break; case true_primitive: #ifdef GPROF_HOOKS asm("gP_TruePrim:"); #endif new.value.fixed = F1; goto boolean_result; case truncate_primitive: #ifdef GPROF_HOOKS asm("gP_TruncPrim:"); #endif switch (optop[-1].type) { case real_type: optop[-1].value.real = (int) optop[-1].value.real; break; case fixed_type: if (optop[-1].value.fixed >= 0) optop[-1].value.fixed = fracti(floorfr(optop[-1].value.fixed)); else optop[-1].value.fixed = -fracti(floorfr(-optop[-1].value.fixed)); break; default: goto typecheck_error; } break; case type_primitive: #ifdef GPROF_HOOKS asm("gP_TypePrim:"); #endif if (optop[-1].type == fixed_type) { if (fractionalbits(optop[-1].value.fixed)) { set_executable_typed_bodied_object(&new, keyword_type, type_table[(int) real_type]); } else { set_executable_typed_bodied_object(&new, keyword_type, type_table[(int) fixed_type]); } } else { set_executable_typed_bodied_object(&new, keyword_type, type_table[(int) optop[-1].type]); } goto typed_result; case version_primitive: { static char version[] = VERSION; #ifdef GPROF_HOOKS asm("gP_VersPrim:"); #endif *optop = make_string(sizeof(version) - 1, version); optop++; } break; case waitprocess_primitive: #ifdef GPROF_HOOKS asm("gP_WaitPrim:"); #endif if (optop[-1].type != process_type) goto typecheck_error; read_14: { register struct execution_environment *ne; #ifdef GPROF_HOOKS asm("gP_CntWaitPrim:"); #endif ne = body_of(optop - 1)->body.process.env; if (ne->event == dead_process) { object_decref(optop - 1); clear_object(optop - 1); } else if (ne->event == zombie_process) { struct object r; r = body_of(optop - 1)->body.process.terminal_value; object_incref(&r); object_decref(optop - 1); optop[-1] = r; } else { ee->event = process_activity_wait; ee->next = waiting_procs; waiting_procs = ee; ee->restart_state = 14; ee->arrstart = (int) ne; goto suspend_process; } } ee->arrstart = -1; break; case widthshow_primitive: #ifdef GPROF_HOOKS asm("gP_WidshowPrim:"); #endif if (optop[-1].type != string_type || optop[-2].type != fixed_type || optop[-3].type != fixed_type || optop[-4].type != fixed_type) goto typecheck_error; if (!cs_hascurrentpoint(&ee->gontext)) goto nocurrentpoint_error; ee->optop = optop; ee->pos = es; cs_frcwidthshow(&ee->gontext, optop[-4].value.fixed, optop[-3].value.fixed, cfloorfr(optop[-2].value.fixed), body_of(optop - 1)->body.string.chars + optop[-1].value.substring.start, optop[-1].value.substring.length); es = ee->pos; optop = ee->optop; object_decref(optop - 1); optop -= 4; break; case write_primitive: #ifdef GPROF_HOOKS asm("gP_WritePrim:"); #endif if (optop[-2].type != file_type || optop[-1].type != fixed_type) goto typecheck_error; { register PSFILE *f = body_of(optop - 2)->body.file.outbuf; if (f == 0 || psio_error(f)) goto ioerror_error; psio_putc(roundfr(optop[-1].value.fixed), f); } goto no_result; case xor_primitive: #ifdef GPROF_HOOKS asm("gP_XorPrim:"); #endif boolean_binary_primitive(^); /* * XXX - This must be implemented properly some day..... */ VM_error: abort(); #ifdef GPROF_HOOKS asm("gP_ResultBase:"); #endif default: unimplemented_primitive: error(unimplemented); break; boolean_result: new.type = boolean_type; goto typed_result; binary_fixed_result: optop--; unary_fixed_result: new.type = fixed_type; optop[-1] = new; break; binary_real_result: optop--; unary_real_result: new.type = real_type; optop[-1] = new; break; real_result: new.type = real_type; goto typed_result; fixed_result: new.type = fixed_type; typed_result: #ifdef GPROF_HOOKS asm("gP_ResultBaseB:"); #endif { register i = ee->execee.value.def->args_used; while (--i >= 0) { --optop; object_decref(optop); } } *optop++ = new; break; no_result: { register i = ee->execee.value.def->args_used; while (--i >= 0) { --optop; object_decref(optop); } } finished_result: break; #ifdef undef } #endif }