Newsgroups: comp.sources.unix From: voodoo@hitl.washington.edu (Geoffery Coco) Subject: v26i198: veos-2.0 - The Virtual Environment Operating Shell, V2.0, Part15/16 Sender: unix-sources-moderator@vix.com Approved: paul@vix.com Submitted-By: voodoo@hitl.washington.edu (Geoffery Coco) Posting-Number: Volume 26, Issue 198 Archive-Name: veos-2.0/part15 #! /bin/sh # This is a shell archive. Remove anything before this line, then unpack # it by saving it into a file and typing "sh file". To overwrite existing # files, type "sh file -c". You can also feed this as standard input via # unshar, or by typing "sh 'kernel_private/src/shell/xv_glutils.c' <<'END_OF_FILE' X/**************************************************************************************** X * * X * file: xv_glutils.c * X * * X * Sundry utilities which serve as glue for xlisp veos primitives. * X * * X * creation: April 13, 1992 * X * * X * * X * by Geoffrey P. Coco at the HITLab, Seattle. * X * * X ****************************************************************************************/ X X X/**************************************************************************************** X * Copyright (C) 1992 Geoffrey P. Coco, Human Interface Technology Lab, Seattle * X ****************************************************************************************/ X X X X/**************************************************************************************** X * preliminaries */ X X#include X#include "xlisp.h" X X/* VEOS definitions: */ X#include "kernel.h" X X#define NATIVE_CODE X#include "xv_native.h" X#undef NATIVE_CODE X X/****************************************************************************************/ X Xextern LVAL xsendmsg0(); Xextern LVAL s_unbound; Xextern LVAL true; Xextern LVAL xlfatal(); X X/****************************************************************************************/ X Xboolean native_bSubstBeenMarked; Xboolean native_bVoidBeenMarked; Xboolean native_bDestruct; X X#define SUBST native_bSubstBeenMarked X#define VOID native_bVoidBeenMarked X#define MOD native_bDestruct X X/****************************************************************************************/ X XTVeosErr Native_PatVEltClerical(); Xextern LVAL ReverseList(); X X/****************************************************************************************/ X X X X X/**************************************************************************************** X Basic Xlisp <--> Nancy Conversion X ****************************************************************************************/ X X X/****************************************************************************************/ XTVeosErr Native_XEltToVElt(pXElt, pVElt) X LVAL pXElt; X TPElt pVElt; X{ X TVeosErr iErr; X X iErr = VEOS_FAILURE; X X X /** NIL is the empty grouple **/ X X if (null(pXElt)) { X iErr = Nancy_NewGrouple(&pVElt->u.pGr); X pVElt->iType = GR_grouple; X } X X X /** case-wise conversion to nancy format **/ X X else { X switch (ntype(pXElt)) { X X case CONS: X /** a list becomes a grouple **/ X iErr = Native_ListToGrouple(pXElt, &pVElt->u.pGr); X pVElt->iType = GR_grouple; X break; X X case VECTOR: X /** a vector becomes a special grouple **/ X iErr = Native_VectToGrouple(pXElt, &pVElt->u.pGr); X pVElt->iType = GR_vector; X break; X X case FIXNUM: X pVElt->iType = GR_int; X pVElt->u.iVal = getfixnum(pXElt); X break; X X case FLONUM: X pVElt->iType = GR_float; X pVElt->u.fVal = (float) getflonum(pXElt); X break; X X case STRING: X pVElt->iType = GR_string; X pVElt->u.pS = strdup((char *) getstring(pXElt)); X break; X X case SYMBOL: X pVElt->iType = GR_prim; X pVElt->u.pS = strdup(getstring(getpname(pXElt))); X break; X X default: X iErr = NATIVE_BADVTYPE; X break; X X } X } X X return(iErr); X X } /* Native_XEltToVElt */ X/****************************************************************************************/ X X X X/****************************************************************************************/ XTVeosErr Native_ListToGrouple(pList, hGrouple) X LVAL pList; X THGrouple hGrouple; X{ X TVeosErr iErr; X LVAL pXFinger; X int iElt; X TPGrouple pGrouple; X TPElt pVFinger; X X X *hGrouple = nil; X X iErr = Nancy_NewGrouple(&pGrouple); X iElt = 0; X X /** convert each lisp sub-element **/ X X pXFinger = pList; X while (!null(pXFinger) && iErr == VEOS_SUCCESS) { X X X /** make room for another grouple element **/ X X Nancy_NewElementsInGrouple(pGrouple, iElt, 1, GR_unspecified, 0); X X X /** do actual element conversion **/ X X iErr = Native_XEltToVElt(car(pXFinger), &pGrouple->pEltList[iElt]); X X X /** advance element refs **/ X X iElt ++; X pXFinger = cdr(pXFinger); X X } /* while */ X X X if (iErr == VEOS_SUCCESS) X *hGrouple = pGrouple; X else X Nancy_DisposeGrouple(pGrouple); X X X return(iErr); X X } /* Native_ListToGrouple */ X/****************************************************************************************/ X X X X/****************************************************************************************/ XTVeosErr Native_VectToGrouple(pVect, hGrouple) X LVAL pVect; X THGrouple hGrouple; X{ X TVeosErr iErr; X int iElts, iEltIndex; X TPGrouple pGrouple; X TPElt pVElt; X X *hGrouple = nil; X X iErr = Nancy_NewGrouple(&pGrouple); X X X iElts = getsz(pVect); X if (iElts > 0 && iErr == VEOS_SUCCESS) { X X /** make enough room for all impending elements **/ X X iErr = Nancy_NewElementsInGrouple(pGrouple, 0, iElts, GR_unspecified, 0); X X X X /** convert each lisp sub-element **/ X X iEltIndex = 0; pVElt = pGrouple->pEltList; X while (iEltIndex < iElts && iErr == VEOS_SUCCESS) { X X iErr = Native_XEltToVElt(getelement(pVect, iEltIndex), pVElt); X X iEltIndex ++; pVElt ++; X } X } X X if (iErr == VEOS_SUCCESS) X *hGrouple = pGrouple; X else X Nancy_DisposeGrouple(pGrouple); X X X return(iErr); X X } /* Native_VectToGrouple */ X/****************************************************************************************/ X X X X/****************************************************************************************/ XTVeosErr Native_VEltToXElt(pVElt, hXElt) X TPElt pVElt; X LVAL *hXElt; X{ X TVeosErr iErr; X X X *hXElt = NIL; X X iErr = VEOS_SUCCESS; X X switch (pVElt->iType) { X X case GR_grouple: X iErr = Native_GroupleToList(pVElt->u.pGr, hXElt); X break; X X case GR_vector: X iErr = Native_GroupleToVect(pVElt->u.pGr, hXElt); X break; X X case GR_int: X *hXElt = cvfixnum(pVElt->u.iVal); X break; X X case GR_float: X *hXElt = cvflonum(pVElt->u.fVal); X break; X X case GR_string: X *hXElt = cvstring(pVElt->u.pS); X break; X X case GR_prim: X *hXElt = xlenter(pVElt->u.pS); X break; X X case GR_unspecified: X iErr = NATIVE_EMPTYELT; X break; X X default: X iErr = NATIVE_BADXTYPE; X break; X X } X X return(iErr); X X } /* Native_VEltToXElt */ X/****************************************************************************************/ X X X X/****************************************************************************************/ XTVeosErr Native_GroupleToList(pGrouple, hList) X TPGrouple pGrouple; X LVAL *hList; X{ X TVeosErr iErr; X LVAL pNewXElt, pList; X int iElts, iElt; X X xlstkcheck(2); X xlsave(pNewXElt); X xlsave(pList); X X iErr = VEOS_SUCCESS; X iElts = pGrouple->iElts; X iElt = iElts - 1; X X while (iElt >= 0 && iErr == VEOS_SUCCESS) { X X iErr = Native_VEltToXElt(&pGrouple->pEltList[iElt], &pNewXElt); X if (iErr == VEOS_SUCCESS) X pList = cons(pNewXElt, pList); X X iElt --; X } X X *hList = pList; X X xlpopn(2); X X return(iErr); X X } /* Native_GroupleToList */ X/****************************************************************************************/ X X X X/****************************************************************************************/ XTVeosErr Native_GroupleToVect(pGrouple, hVect) X TPGrouple pGrouple; X LVAL *hVect; X{ X TVeosErr iErr; X LVAL pNewXElt, pVect; X int iElts, iElt; X X xlstkcheck(2); X xlsave(pVect); X xlsave(pNewXElt); X X iErr = VEOS_SUCCESS; X iElts = pGrouple->iElts; X iElt = 0; X X pVect = newvector(iElts); X X while (iElt < iElts && iErr == VEOS_SUCCESS) { X X iErr = Native_VEltToXElt(&pGrouple->pEltList[iElt], &pNewXElt); X if (iErr == VEOS_SUCCESS) X setelement(pVect, iElt, pNewXElt); X X iElt ++; X } X X *hVect = pVect; X X xlpopn(2); X X return(iErr); X X } /* Native_GroupleToVect */ X/****************************************************************************************/ X X X X/**************************************************************************************** X Timestamped Xlisp <--> Nancy Conversion X ****************************************************************************************/ X X/****************************************************************************************/ XTVeosErr Native_NewVEltToXElt(pVElt, hXElt, time) X TPElt pVElt; X LVAL *hXElt; X TTimeStamp time; X{ X TVeosErr iErr; X X *hXElt = NIL; X iErr = NATIVE_STALE; X X if (TIME_LESS_THAN(pVElt->tLastMod, time)) { X X /** old data, retrieve only contents of containers X **/ X if (pVElt->iType == GR_grouple) X iErr = Native_NewGroupleToList(pVElt->u.pGr, hXElt, time); X X else if (pVElt->iType == GR_vector) X iErr = Native_NewGroupleToVect(pVElt->u.pGr, hXElt, time); X } X X else { X /** new data, retrieve completely **/ X X switch (pVElt->iType) { X X case GR_grouple: X iErr = Native_GroupleToList(pVElt->u.pGr, hXElt); X break; X X case GR_vector: X iErr = Native_GroupleToVect(pVElt->u.pGr, hXElt); X break; X X case GR_int: X *hXElt = cvfixnum(pVElt->u.iVal); X iErr = VEOS_SUCCESS; X break; X X case GR_float: X *hXElt = cvflonum(pVElt->u.fVal); X iErr = VEOS_SUCCESS; X break; X X case GR_string: X *hXElt = cvstring(pVElt->u.pS); X iErr = VEOS_SUCCESS; X break; X X case GR_prim: X *hXElt = xlenter(pVElt->u.pS); X iErr = VEOS_SUCCESS; X break; X X case GR_unspecified: X iErr = NATIVE_EMPTYELT; X break; X X default: X iErr = NATIVE_BADXTYPE; X break; X X } X } X X return(iErr); X X } /* Native_NewVEltToXElt */ X/****************************************************************************************/ X X X X/****************************************************************************************/ XTVeosErr Native_NewGroupleToList(pGrouple, hList, time) X TPGrouple pGrouple; X LVAL *hList; X TTimeStamp time; X{ X TVeosErr iErr = VEOS_SUCCESS; X LVAL pNewXElt, pList; X int iElts, iElt; X TPElt pVElt; X boolean bStale = TRUE; X X xlsave1(pNewXElt); X xlsave1(pList); X X iElts = pGrouple->iElts; X iElt = iElts - 1; X X while (iElt >= 0) { X X /** determine if caller has already seen this data **/ X X iErr = Native_NewVEltToXElt(&pGrouple->pEltList[iElt], &pNewXElt, time); X if (iErr == VEOS_SUCCESS) { X /** assume caller has locked this ptr **/ X X pList = cons(pNewXElt, pList); X bStale = FALSE; X } X X else if (iErr == NATIVE_STALE) X iErr = VEOS_SUCCESS; X X else X break; X X iElt --; X } X X if (iErr == VEOS_SUCCESS) { X if (bStale) X iErr = NATIVE_STALE; X X *hList = pList; X } X X xlpopn(2); X X return(iErr); X X } /* Native_NewGroupleToList */ X/****************************************************************************************/ X X X X/****************************************************************************************/ XTVeosErr Native_NewGroupleToVect(pGrouple, hVect, time) X TPGrouple pGrouple; X LVAL *hVect; X TTimeStamp time; X{ X TVeosErr iErr = VEOS_SUCCESS; X LVAL pNewXElt, pVect; X int iElts, iElt; X boolean bStale = TRUE; X X xlsave1(pNewXElt); X xlsave1(pVect); X X iElts = pGrouple->iElts; X pVect = newvector(iElts); X X iElt = 0; X X while (iElt < iElts) { X X iErr = Native_NewVEltToXElt(&pGrouple->pEltList[iElt], &pNewXElt, time); X if (iErr == VEOS_SUCCESS) { X X /** assume caller has locked this ptr **/ X X setelement(pVect, iElt, pNewXElt); X bStale = FALSE; X } X X else if (iErr == NATIVE_STALE) X iErr = VEOS_SUCCESS; X X else X break; X X iElt ++; X } X X if (iErr == VEOS_SUCCESS) { X if (bStale) X iErr = NATIVE_STALE; X X *hVect = pVect; X } X X xlpopn(2); X X return(iErr); X X } /* Native_NewGroupleToVect */ X/****************************************************************************************/ X X X X/****************************************************************************************/ XTVeosErr Native_XEltToNewVElt(pXElt, pVElt, time) X LVAL pXElt; X TPElt pVElt; X TTimeStamp time; X{ X TVeosErr iErr; X X iErr = VEOS_SUCCESS; X X X /** NIL is the empty grouple **/ X X if (null(pXElt)) { X pVElt->iType = GR_grouple; X iErr = Nancy_NewGrouple(&pVElt->u.pGr); X } X X /** case-wise conversion to nancy format **/ X X else { X switch (ntype(pXElt)) { X X case CONS: X /** a list becomes a grouple **/ X iErr = Native_ListToNewGrouple(pXElt, &pVElt->u.pGr, time); X pVElt->iType = GR_grouple; X break; X X case VECTOR: X /** a vector becomes a special grouple **/ X iErr = Native_VectToNewGrouple(pXElt, &pVElt->u.pGr, time); X pVElt->iType = GR_vector; X break; X X case FIXNUM: X pVElt->iType = GR_int; X pVElt->u.iVal = getfixnum(pXElt); X break; X X case FLONUM: X pVElt->iType = GR_float; X pVElt->u.fVal = (float) getflonum(pXElt); X break; X X case STRING: X pVElt->iType = GR_string; X pVElt->u.pS = strdup((char *) getstring(pXElt)); X break; X X case SYMBOL: X pVElt->iType = GR_prim; X pVElt->u.pS = strdup(getstring(getpname(pXElt))); X break; X X default: X iErr = NATIVE_BADVTYPE; X break; X X } X } X X pVElt->tLastMod = time; X X return(iErr); X X } /* Native_XEltToNewVElt */ X/****************************************************************************************/ X X X X/****************************************************************************************/ XTVeosErr Native_ListToNewGrouple(pList, hGrouple, time) X LVAL pList; X THGrouple hGrouple; X TTimeStamp time; X{ X TVeosErr iErr; X LVAL pXFinger; X int iElt; X TPGrouple pGrouple; X TPElt pVFinger; X X xlsave1(pXFinger); X X *hGrouple = nil; X X iErr = Nancy_NewGrouple(&pGrouple); X iElt = 0; X X X /** convert each lisp sub-element **/ X X pXFinger = pList; X while (!null(pXFinger) && iErr == VEOS_SUCCESS) { X X X /** make room for another grouple element **/ X X Nancy_NewElementsInGrouple(pGrouple, iElt, 1, GR_unspecified, 0); X X X /** do actual element conversion **/ X X iErr = Native_XEltToNewVElt(car(pXFinger), &pGrouple->pEltList[iElt], time); X X X /** advance element refs **/ X X iElt ++; X pXFinger = cdr(pXFinger); X X } /* while */ X X X if (iErr == VEOS_SUCCESS) X *hGrouple = pGrouple; X else X Nancy_DisposeGrouple(pGrouple); X X xlpop(); X X return(iErr); X X } /* Native_ListToNewGrouple */ X/****************************************************************************************/ X X X X/****************************************************************************************/ XTVeosErr Native_VectToNewGrouple(pVect, hGrouple, time) X LVAL pVect; X THGrouple hGrouple; X TTimeStamp time; X{ X TVeosErr iErr; X int iElts, iEltIndex; X TPGrouple pGrouple; X X X *hGrouple = nil; X X iErr = Nancy_NewGrouple(&pGrouple); X X X iElts = getsz(pVect); X if (iElts > 0 && iErr == VEOS_SUCCESS) { X X /** make enough room for all impending elements **/ X X iErr = Nancy_NewElementsInGrouple(pGrouple, 0, iElts, GR_unspecified, 0); X X X X /** convert each lisp sub-element **/ X X iEltIndex = 0; X while (iEltIndex < iElts && iErr == VEOS_SUCCESS) { X X iErr = Native_XEltToNewVElt(getelement(pVect, iEltIndex), X &pGrouple->pEltList[iEltIndex], time); X iEltIndex ++; X } X } X X if (iErr == VEOS_SUCCESS) X *hGrouple = pGrouple; X else X Nancy_DisposeGrouple(pGrouple); X X X return(iErr); X X } /* Native_VectToNewGrouple */ X/****************************************************************************************/ X X X/**************************************************************************************** X Pattern Xlisp <--> Nancy Conversion X ****************************************************************************************/ X X X/****************************************************************************************/ XTVeosErr Native_GetPatternArg(hPattern, iMatchFlag) X THGrouple hPattern; X int iMatchFlag; X{ X LVAL pXElt; X TVeosErr iErr; X X X SUBST = FALSE; X VOID = FALSE; X MOD = (iMatchFlag == NANCY_ReplaceMatch); X X X /** get lisp pattern list **/ X X pXElt = xlgalist(); X X X /** dispatch lisp->veos conversion **/ X X iErr = Native_PatListToGrouple(pXElt, hPattern); X X#ifndef OPTIMAL X if (iErr == VEOS_SUCCESS) { X if (iMatchFlag == NANCY_ReplaceMatch) { X if (!SUBST && !VOID) X iErr = NATIVE_NOREPLACEMARK; X } X else { X if (VOID) X iErr = NATIVE_NOVOID; X else if (!SUBST) X iErr = NATIVE_NOFETCHMARK; X } X } X#endif X X return(iErr); X X } /* Native_GetPatternArg */ X/****************************************************************************************/ X X X X/****************************************************************************************/ XTVeosErr Native_PatXEltToVElt(pXElt, pVElt) X LVAL pXElt; X TPElt pVElt; X{ X TVeosErr iErr; X X iErr = VEOS_SUCCESS; X X X /** NIL is the empty grouple **/ X X if (null(pXElt)) { X iErr = Nancy_NewGrouple(&pVElt->u.pGr); X pVElt->iType = GR_grouple; X } X X X /** case-wise conversion to nancy format **/ X X else { X switch (ntype(pXElt)) { X X case CONS: X /** a list becomes a grouple **/ X iErr = Native_PatListToGrouple(pXElt, &pVElt->u.pGr); X pVElt->iType = GR_grouple; X break; X X case VECTOR: X /** a vector becomes a special grouple **/ X iErr = Native_PatVectToGrouple(pXElt, &pVElt->u.pGr); X pVElt->iType = GR_vector; X break; X X case FIXNUM: X pVElt->iType = GR_int; X pVElt->u.iVal = getfixnum(pXElt); X break; X X case FLONUM: X pVElt->iType = GR_float; X pVElt->u.fVal = (float) getflonum(pXElt); X break; X X case STRING: X pVElt->iType = GR_string; X pVElt->u.pS = strdup((char *) getstring(pXElt)); X break; X X case SYMBOL: X iErr = Native_ConvertSymbol(pXElt, pVElt); X break; X X default: X iErr = NATIVE_BADVTYPE; X break; X } X } X X return(iErr); X X } /* Native_PatXEltToVElt */ X/****************************************************************************************/ X X X X/****************************************************************************************/ XTVeosErr Native_PatListToGrouple(pList, hGrouple) X LVAL pList; X THGrouple hGrouple; X{ X TVeosErr iErr; X LVAL pXFinger; X int iElt; X TPGrouple pGrouple; X TPElt pVFinger; X TPatStatRec patPB; X TElt eltNew; X X X /****************** X ** setup locals ** X ******************/ X X *hGrouple = nil; X iErr = Nancy_NewGrouple(&pGrouple); X X /** by default, a grouple is literally an ordered list of elements. X ** in some cases, a pattern grouple can specifiy an order-blind element X ** collection. in other words, a content-dependent-pattern. X **/ X patPB.bOrdered = TRUE; X X /** prepare to check for pattern format inconsistencies **/ X X patPB.bExpContent = FALSE; X patPB.bExpOrder = FALSE; X patPB.bMarkedWithin = FALSE; X patPB.bTouchedWithin = FALSE; X X patPB.bMarkNextElt = FALSE; X patPB.bTouchNextElt = FALSE; X patPB.bMustEnd = FALSE; X patPB.bGetAnother = FALSE; X X X /*********************************** X ** convert each lisp sub-element ** X ***********************************/ X X pXFinger = pList; X while (!null(pXFinger)) { X X eltNew = NIL_ELT; X X /** do actual element conversion **/ X X iErr = Native_PatXEltToVElt(car(pXFinger), &eltNew); X if (iErr != VEOS_SUCCESS) X break; X X iErr = Native_PatVEltClerical(&eltNew, &patPB); X if (iErr != VEOS_SUCCESS) X break; X X if (patPB.bGetAnother) { X X /** this elt was actually a modifier elt for next one. X ** prepare for caller forgetting to pass next elt X **/ X iErr = NATIVE_NOTEND; X } X X else { X /** place converted nancy element into dest grouple **/ X X Nancy_NewElementsInGrouple(pGrouple, pGrouple->iElts, X 1, GR_unspecified, 0); X pGrouple->pEltList[pGrouple->iElts - 1] = eltNew; X } X X X /** advance element refs **/ X X pXFinger = cdr(pXFinger); X } /* while */ X X if (iErr != VEOS_SUCCESS) X Nancy_DisposeGrouple(pGrouple); X X else { X if (!patPB.bOrdered) X SETFLAG(NANCY_ContentMask, pGrouple->iFlags); X if (patPB.bMarkedWithin) X SETFLAG(NANCY_MarkWithinMask, pGrouple->iFlags); X if (patPB.bTouchedWithin) X SETFLAG(NANCY_TouchWithinMask, pGrouple->iFlags); X X *hGrouple = pGrouple; X } X X return(iErr); X X } /* Native_PatListToGrouple */ X/****************************************************************************************/ X X X X/****************************************************************************************/ XTVeosErr Native_PatVectToGrouple(pVect, hGrouple) X LVAL pVect; X THGrouple hGrouple; X{ X TVeosErr iErr; X LVAL pXFinger; X int iXElts, iXEltIndex; X TPGrouple pGrouple; X TPatStatRec patPB; X TElt eltNew; X X /****************** X ** setup locals ** X ******************/ X X *hGrouple = nil; X iErr = Nancy_NewGrouple(&pGrouple); X X /** by default, a grouple is literally an ordered list of elements. X ** in some cases, a pattern grouple can specifiy an order-blind element X ** collection. in other words, a content-dependent-pattern. X **/ X patPB.bOrdered = TRUE; X X /** prepare to check for pattern format inconsistencies **/ X X patPB.bExpContent = FALSE; X patPB.bExpOrder = FALSE; X patPB.bMarkedWithin = FALSE; X patPB.bTouchedWithin = FALSE; X X patPB.bMarkNextElt = FALSE; X patPB.bTouchNextElt = FALSE; X patPB.bMustEnd = FALSE; X patPB.bGetAnother = FALSE; X X iXElts = getsz(pVect); X if (iXElts > 0 && iErr == VEOS_SUCCESS) { X X /*********************************** X ** convert each lisp sub-element ** X ***********************************/ X X iXEltIndex = 0; X while (iXEltIndex < iXElts) { X X X /** cache current vector element **/ X X pXFinger = getelement(pVect, iXEltIndex); X eltNew = NIL_ELT; X X /** do actual element conversion **/ X X iErr = Native_PatXEltToVElt(pXFinger, &eltNew); X if (iErr != VEOS_SUCCESS) X break; X X iErr = Native_PatVEltClerical(&eltNew, &patPB); X if (iErr != VEOS_SUCCESS) X break; X X if (patPB.bGetAnother) { X X /** this elt was actually a modifier elt for next one. X ** prepare for caller forgetting to pass next elt X **/ X iErr = NATIVE_NOTEND; X } X X else { X /** place converted nancy element into dest grouple **/ X X Nancy_NewElementsInGrouple(pGrouple, pGrouple->iElts, X 1, GR_unspecified, 0); X pGrouple->pEltList[pGrouple->iElts - 1] = eltNew; X } X X X /** advance element refs **/ X X iXEltIndex ++; X X } /* while */ X } X X if (iErr != VEOS_SUCCESS) X Nancy_DisposeGrouple(pGrouple); X X else { X if (!patPB.bOrdered) X SETFLAG(NANCY_ContentMask, pGrouple->iFlags); X if (patPB.bMarkedWithin) X SETFLAG(NANCY_MarkWithinMask, pGrouple->iFlags); X if (patPB.bTouchedWithin) X SETFLAG(NANCY_TouchWithinMask, pGrouple->iFlags); X X *hGrouple = pGrouple; X } X X return(iErr); X X } /* Native_PatVectToGrouple */ X/****************************************************************************************/ X X X X/****************************************************************************************/ XTVeosErr Native_PatVEltClerical(pVElt, pStats) X TPElt pVElt; X TPPatStatRec pStats; X{ X TVeosErr iErr = VEOS_SUCCESS; X X#ifndef OPTIMAL X if (pStats->bMustEnd) X iErr = NATIVE_NOTEND; X X else { X /** catch possible undefined expressions **/ X X switch (pVElt->iType) { X X case GR_these: X if (pStats->bExpContent) X iErr = NATIVE_CANTMIX; X break; X X case GR_theseall: X if (pStats->bExpContent) X iErr = NATIVE_CANTMIX; X break; X X case GR_some: X iErr = NATIVE_NOSTARN; X break; X X case GR_any: X if (pStats->bExpOrder) X iErr = NATIVE_CANTMIX; X break; X X case GR_here: X if (SUBST || VOID) X iErr = NATIVE_TOOMANYMARKS; X else if (pStats->bGetAnother) X iErr = NATIVE_MODVOID; X break; X X case GR_mark: X if (SUBST || VOID) X iErr = NATIVE_TOOMANYMARKS; X else if (pStats->bGetAnother) X iErr = NATIVE_THISWHAT; X break; X X case GR_touch: X if (!MOD) X iErr = NATIVE_NOTOUCH; X else if (pStats->bGetAnother) X iErr = NATIVE_THISWHAT; X break; X X default: X break; X } /* switch */ X } X#endif X X if (iErr == VEOS_SUCCESS) { X X /** mark the element for nancy matcher **/ X X if (pStats->bMarkNextElt) { X SETFLAG(NANCY_EltMarkMask, pVElt->iFlags); X pStats->bMarkNextElt = FALSE; X pStats->bGetAnother = FALSE; X } X X if (pStats->bTouchNextElt) { X SETFLAG(NANCY_EltTouchMask, pVElt->iFlags); X pStats->bTouchNextElt = FALSE; X pStats->bGetAnother = FALSE; X } X X X switch (pVElt->iType) { X X case GR_these: X pStats->bExpOrder = TRUE; X break; X X case GR_any: X pStats->bOrdered = FALSE; X pStats->bExpContent = TRUE; X pStats->bMustEnd = TRUE; X break; X X case GR_theseall: X pStats->bExpOrder = TRUE; X pStats->bMustEnd = TRUE; X break; X X case GR_here: X VOID = TRUE; X SETFLAG(NANCY_EltMarkMask, pVElt->iFlags); X pStats->bMarkedWithin = TRUE; X break; X X case GR_mark: X SUBST = TRUE; X pStats->bMarkedWithin = TRUE; X pStats->bMarkNextElt = TRUE; X pStats->bGetAnother = TRUE; X break; X X case GR_touch: X pStats->bTouchedWithin = TRUE; X pStats->bTouchNextElt = TRUE; X pStats->bGetAnother = TRUE; X break; X X default: X break; X } /* switch */ X } X X return(iErr); X X } /* Native_PatVEltClerical */ X/****************************************************************************************/ X X X X/****************************************************************************************/ XTVeosErr Native_ConvertSymbol(pXElt, pVElt) X LVAL pXElt; X TPElt pVElt; X{ X TVeosErr iErr = VEOS_SUCCESS; X char *sSrc; X boolean bParsed = FALSE; X X X sSrc = (char *) getstring(getpname(pXElt)); X X switch(sSrc[0]) { X X X case '^': /* '^' marks the void for insertion */ X if (sSrc[1] == '\0') { X pVElt->iType = GR_here; X bParsed = TRUE; X } X break; X X case '>': /* '>' is a mark for the next element */ X if (sSrc[1] == '\0') { X pVElt->iType = GR_mark; X bParsed = TRUE; X } X break; X X case '~': /* '~' touches the next element */ X if (sSrc[1] == '\0') { X pVElt->iType = GR_touch; X bParsed = TRUE; X } X break; X X case '@': /* '@' is wildcard for ordered elements **/ X X /** special form (@) means exactly one element **/ X if (sSrc[1] == '\0') { X pVElt->iType = GR_these; X pVElt->u.iVal = 1; X bParsed = TRUE; X } X X /** special form (@n) means exactly n elts **/ X else if (IsIntStr(&sSrc[1]) == VEOS_SUCCESS) { X if ((pVElt->u.iVal = atoi(&sSrc[1])) < 1) X iErr = NATIVE_CRAZYWILD; X else X pVElt->iType = GR_these; X bParsed = TRUE; X } X X /** special form (@@) means zero or more elts **/ X else if (sSrc[1] == '@' && sSrc[2] == '\0') { X pVElt->iType = GR_theseall; X bParsed = TRUE; X } X break; X X X case '*': /* '*' is wildcard for unordered elements */ X X /** special form (*) means exatly one element **/ X if (sSrc[1] == '\0') { X pVElt->iType = GR_some; X pVElt->u.iVal = 1; X bParsed = TRUE; X } X X /** special form (*n) means exactly n elts **/ X else if (IsIntStr(&sSrc[1]) == VEOS_SUCCESS) { X if ((pVElt->u.iVal = atoi(&sSrc[1])) < 1) X iErr = NATIVE_CRAZYWILD; X else X pVElt->iType = GR_some; X bParsed = TRUE; X } X X /** special form (**) means zero or more elts **/ X else if (sSrc[1] == '*' && sSrc[2] == '\0') { X pVElt->iType = GR_any; X bParsed = TRUE; X } X break; X X } /* switch */ X X X /** save symbol's name as veos prim type **/ X X if (!bParsed && iErr == VEOS_SUCCESS) { X pVElt->iType = GR_prim; X pVElt->u.pS = strdup(sSrc); X } X X X return(iErr); X X } /* Native_ConvertSymbol */ X/****************************************************************************************/ X X X X/**************************************************************************************** X Xlisp <--> Linearized Data Conversion X ****************************************************************************************/ X X X/****************************************************************************************/ XTVeosErr Native_XEltToMsgRec(pXData, pMsgRec) X LVAL pXData; X TPMsgRec pMsgRec; X{ X TVeosErr iErr; X X pMsgRec->iLen = 0; X pMsgRec->sMessage = TALK_BUFFER; X X X /** perform data conversion to flat network-friendly form **/ X X iErr = Native_XEltToMessage(pXData, pMsgRec->sMessage, &pMsgRec->iLen); X X if (iErr != VEOS_SUCCESS) X Native_TrapErr(iErr, pXData); X X X return(iErr); X X } /* Native_XEltToMsgRec */ X/****************************************************************************************/ X X X X/****************************************************************************************/ XTVeosErr Native_XEltToMessage(pXElt, pBuffer, pLen) X LVAL pXElt; X char *pBuffer; X int *pLen; X{ X TVeosErr iErr; X int iLen; X TF2L fTrans; X X iErr = VEOS_SUCCESS; X X /** message element is: element type, then data (except for NIL) X ** assume pBuffer is aligned X **/ X X if (null(pXElt)) { X X /** nil element is empty grouple **/ X *(int *) pBuffer = htonl(GR_grouple); X pBuffer += 4; X X /** empty grouple has zero elements **/ X *(int *) pBuffer = htonl(0); X X iLen = 8; X } X else { X X switch (ntype(pXElt)) { X X case CONS: X *(int *) pBuffer = htonl(GR_grouple); X pBuffer += 4; X iLen = 4; X iErr = Native_ListToMessage(pXElt, pBuffer, &iLen); X break; X X case VECTOR: X *(int *) pBuffer = htonl(GR_vector); X pBuffer += 4; X iLen = 4; X iErr = Native_VectToMessage(pXElt, pBuffer, &iLen); X break; X X case FIXNUM: X *(int *) pBuffer = htonl(GR_int); X pBuffer += 4; X *(long *) pBuffer = htonl(getfixnum(pXElt)); X iLen = 8; X break; X X case FLONUM: X *(int *) pBuffer = htonl(GR_float); X pBuffer += 4; X fTrans.u.f = getflonum(pXElt); X *(long *) pBuffer = htonl(fTrans.u.l); X iLen = 8; X break; X X case STRING: X *(int *) pBuffer = htonl(GR_string); X pBuffer += 4; X strcpy(pBuffer, getstring(pXElt)); X iLen = 4 + MEMSIZE(strlen(getstring(pXElt)) + 1); X break; X X case SYMBOL: X *(int *) pBuffer = htonl(GR_prim); X pBuffer += 4; X strcpy(pBuffer, getstring(getpname(pXElt))); X iLen = 4 + MEMSIZE(strlen(getstring(getpname(pXElt))) + 1); X break; X X default: X iErr = NATIVE_BADVTYPE; X iLen = 0; X break; X X } /* switch */ X } X X *pLen += iLen; X X return(iErr); X X } /* Native_XEltToMessage */ X/****************************************************************************************/ X X X X/****************************************************************************************/ XTVeosErr Native_ListToMessage(pList, pBuffer, pLen) X LVAL pList; X char *pBuffer; X int *pLen; X{ X TVeosErr iErr = VEOS_SUCCESS; X LVAL pXFinger; X int iLen, iElts = 0; X char *pListHead; X X X /** first code of protocol is number of elements, write later **/ X X pListHead = pBuffer; X pBuffer = pListHead + 4; X *pLen += 4; X X X /** convert each lisp sub-element **/ X X pXFinger = pList; X while (!null(pXFinger)) { X X /** invoke recursive translation **/ X X iLen = 0; X iErr = Native_XEltToMessage(car(pXFinger), pBuffer, &iLen); X X if (iErr != VEOS_SUCCESS) X break; X X else { X iElts ++; X X pBuffer += iLen; X *pLen += iLen; X } X X /** advance element ref **/ X X pXFinger = cdr(pXFinger); X X } /* while */ X X X /** write number of elements **/ X X *(int *) pListHead = htonl(iElts); X X return(iErr); X X } /* Native_ListToMessage */ X/****************************************************************************************/ X X X X X/****************************************************************************************/ XTVeosErr Native_VectToMessage(pVect, pBuffer, pLen) X LVAL pVect; X char *pBuffer; X int *pLen; X{ X TVeosErr iErr = VEOS_SUCCESS; X LVAL pXFinger; X int iLen, iEltIndex, iElts; X X iElts = getsz(pVect); X X /** first code of protocol is number of elements **/ X *(int *) pBuffer = htonl(iElts); X X pBuffer += 4; X *pLen += 4; X X X /** convert each lisp sub-element **/ X X iEltIndex = 0; X while(iEltIndex < iElts) { X X X /** invoke recursive translation **/ X X iLen = 0; X iErr = Native_XEltToMessage(getelement(pVect, iEltIndex), pBuffer, &iLen); X X if (iErr != VEOS_SUCCESS) X break; X X else { X pBuffer += iLen; X *pLen += iLen; X } X X X /** advance element ref **/ X X iEltIndex ++; X X } /* while */ X X X return(iErr); X X } /* Native_VectToMessage */ X/****************************************************************************************/ X X X X X/****************************************************************************************/ XTVeosErr Native_MessageToXElt(pBuffer, hXElt, pLen) X char *pBuffer; X LVAL *hXElt; X int *pLen; X{ X TVeosErr iErr = VEOS_SUCCESS; X int iLen, iType; X TF2L fTrans; X X *hXElt = NIL; X X iType = ntohl(*(int *) pBuffer); /** assume pBuffer is aligned **/ X X pBuffer += 4; X *pLen += 4; X X switch (iType) { X X case GR_grouple: X iLen = 0; X iErr = Native_MessageToList(pBuffer, hXElt, &iLen); X break; X X case GR_vector: X iLen = 0; X iErr = Native_MessageToVect(pBuffer, hXElt, &iLen); X break; X X case GR_int: X *hXElt = cvfixnum((int) ntohl(*(long *) pBuffer)); X iLen = 4; X break; X X case GR_float: X fTrans.u.l = ntohl(*(long *) pBuffer); X *hXElt = cvflonum(fTrans.u.f); X iLen = 4; X break; X X case GR_string: X *hXElt = cvstring(pBuffer); X iLen = MEMSIZE(strlen(pBuffer) + 1); X break; X X case GR_prim: X *hXElt = xlenter(pBuffer); X iLen = MEMSIZE(strlen(pBuffer) + 1); X break; X X case GR_unspecified: X default: X iLen = 0; X break; X X } /* switch */ X X *pLen += iLen; X X return(iErr); X X } /* Native_MessageToXElt */ X/****************************************************************************************/ X X X X/****************************************************************************************/ XTVeosErr Native_MessageToList(pBuffer, hList, pLen) X char *pBuffer; X LVAL *hList; X int *pLen; X{ X TVeosErr iErr = VEOS_SUCCESS; X LVAL pXFinger; X int iLen, iElts, iEltIndex; X char *pListHead; X LVAL pList, pXElt; X X xlstkcheck(2); X xlsave(pList); X xlsave(pXElt); X X /** extract # of elements from first part of grouple data **/ X X iElts = ntohl(*(int *) pBuffer); X X pBuffer += 4; X *pLen += 4; X X X /** convert each element one at a time, 'talk msg format' -> list' **/ X X iEltIndex = 0; X while (iEltIndex < iElts) { X X iLen = 0; X X /** extract elt data, allocate specific elt mem, stuff it with data. **/ X X iErr = Native_MessageToXElt(pBuffer, &pXElt, &iLen); X X if (iErr != VEOS_SUCCESS) X break; X X else { X pBuffer += iLen; X *pLen += iLen; X X pList = cons(pXElt, pList); X } X X iEltIndex ++; X } X X if (iErr == VEOS_SUCCESS) { X X *hList = ReverseList(pList); X } X X xlpopn(2); X X return(iErr); X X } /* Native_MessageToList */ X/****************************************************************************************/ X X X X X/****************************************************************************************/ XTVeosErr Native_MessageToVect(pBuffer, hVect, pLen) X char *pBuffer; X LVAL *hVect; X int *pLen; X{ X TVeosErr iErr = VEOS_SUCCESS; X int iLen, iElts, iEltIndex; X LVAL pVect, pXElt; X X xlstkcheck(2); X xlsave(pVect); X xlsave(pXElt); X X /** extract # of elements from first part of grouple data **/ X X iElts = ntohl(*(int *) pBuffer); X X pBuffer += 4; X *pLen += 4; X X X /** create new lisp vector as container **/ X X pVect = newvector(iElts); X X X /** convert each element one at a time **/ X X iEltIndex = 0; X while (iEltIndex < iElts) { X X iLen = 0; X X /** extract elt data, allocate specific elt mem, stuff it with data. **/ X X iErr = Native_MessageToXElt(pBuffer, &pXElt, &iLen); X if (iErr != VEOS_SUCCESS) X break; X X else { X pBuffer += iLen; X *pLen += iLen; X X setelement(pVect, iEltIndex, pXElt); X } X X iEltIndex ++; X } X X X if (iErr == VEOS_SUCCESS) X *hVect = pVect; X X xlpopn(2); X X return(iErr); X X } /* Native_MessageToVect */ X/****************************************************************************************/ X X X X/****************************************************************************************/ XTVeosErr Native_TrapErr(iErr, pXElt) X TVeosErr iErr; X LVAL pXElt; X{ X str63 sErr; X X switch(iErr) { X X case NATIVE_BADTYPE: X xlbadtype(pXElt); X break; X case NATIVE_NOKERNEL: X xlfail("veos kernel not initialized, use (vinit )"); X break; X case NATIVE_BADFREQ: X xlerror("'!' expected", pXElt); X break; X case NATIVE_2KERNELS: X xlfail("veos kernel already initialized"); X break; X case NATIVE_BADVTYPE: X xlerror("veos does not support that data type", pXElt == nil ? s_unbound : pXElt); X break; X case NATIVE_BADXTYPE: X xlerror("xlisp does not support that data type from veos", X pXElt == nil ? s_unbound : pXElt); X break; X case NATIVE_EMPTYELT: X xlerror("empty data element from veos, probably a memory error", X pXElt == nil ? s_unbound : pXElt); X break; X case NATIVE_NODATA: X xlerror("no veos data to match... only the void remains", s_unbound); X break; X case NATIVE_THISWHAT: X xlerror("pattern element modifier ('>' or '~') must be followed by a matchable element", pXElt == nil ? s_unbound : pXElt); X break; X case NATIVE_TOOMANYMARKS: X xlerror("patterns must contain exactly one '>' or '^'", X pXElt == nil ? s_unbound : pXElt); X break; X case NATIVE_CANTMIX: X xlerror("can't mix '@' and '*'", pXElt == nil ? s_unbound : pXElt); X break; X case NATIVE_NOTEND: X xlerror("indefinite wildcards (eg '@@' or '**') can only appear at end of grouple in pattern", X pXElt == nil ? s_unbound : pXElt); X break; X case NATIVE_NOREPLACEMARK: X xlerror("pattern must contain '>' or '^'", pXElt == nil ? s_unbound : pXElt); X break; X case NATIVE_NOFETCHMARK: X xlerror("pattern must contain '>'", pXElt == nil ? s_unbound : pXElt); X break; X case NATIVE_NOVOID: X xlerror("cannot get or copy from the void ('^')", X pXElt == nil ? s_unbound : pXElt); X break; X case NATIVE_BADPATSYMBOL: X xlerror("symbol not recognized", pXElt == nil ? s_unbound : pXElt); X break; X case NATIVE_CRAZYWILD: X xlerror("nonsensical number of wildcard elements", X pXElt == nil ? s_unbound : pXElt); X break; X case NATIVE_MATCHFAIL: X xlerror("match and/or replace did not succeed", X pXElt == nil ? s_unbound : pXElt); X break; X case NATIVE_NOSTARN: X xlerror("the '*n' feature is not supported", X pXElt == nil ? s_unbound : pXElt); X break; X case NATIVE_BADVOID: X xlerror("ambiguous void marker (can't use '^' in pattern grouple containing '*')", X pXElt == nil ? s_unbound : pXElt); X break; X case NATIVE_NOHOST: X xlerror("host not recognized", pXElt == nil ? s_unbound : pXElt); X break; X case NATIVE_NOTOUCH: X xlerror("can't touch (eg. '~') elements during nondestructive grouplespace access", pXElt == nil ? s_unbound : pXElt); X break; X case NATIVE_MODVOID: X xlerror("can't use element modifiers ('>' or '~') with the void ('^')", pXElt == nil ? s_unbound : pXElt); X break; X case VEOS_SUCCESS: X break; X default: X sprintf(sErr, "unexpected error %d", iErr); X xlerror(sErr, pXElt == nil ? s_unbound : pXElt); X break; X } X X return(VEOS_SUCCESS); X X } /* Native_TrapErr */ X/****************************************************************************************/ X X X X/****************************************************************************************/ Xboolean IsUidElt(pXElt) X LVAL pXElt; X{ X return(vectorp(pXElt) && X getsz(pXElt) == 2 && X stringp(getelement(pXElt, 0)) && X fixp(getelement(pXElt, 1))); X X } /* IsUidElt */ X/****************************************************************************************/ X X X/****************************************************************************************/ XTVeosErr XVect2Uid(pXElt, pUid) X LVAL pXElt; X TPUid pUid; X{ X TVeosErr iErr; X X /** assume sanity is checked **/ X X iErr = Sock_ResolveHost(getstring(getelement(pXElt, 0)), &pUid->lHost); X if (iErr == VEOS_SUCCESS) X pUid->iPort = getfixnum(getelement(pXElt, 1)); X else X iErr = NATIVE_NOHOST; X X return(iErr); X X } /* XVect2Uid */ X/****************************************************************************************/ X X X/****************************************************************************************/ XTVeosErr Uid2XVect(pUid, hXElt) X TPUid pUid; X LVAL *hXElt; X{ X str255 sTemp; X X /** assume sanity is checked **/ X X if (Sock_IP2StrHost(pUid->lHost, sTemp) == VEOS_SUCCESS || X Sock_IP2StrAddr(pUid->lHost, sTemp) == VEOS_SUCCESS) { X X /** assume caller locked *hXElt **/ X X *hXElt = newvector(2); X setelement(*hXElt, 0, cvstring(sTemp)); X setelement(*hXElt, 1, cvfixnum(pUid->iPort)); X } X X return(VEOS_SUCCESS); X X } /* Uid2XVect */ X/****************************************************************************************/ X X X X/****************************************************************************************/ XTVeosErr Native_XVectsToUids(pList, hDests) X LVAL pList; X THUidNode hDests; X{ X TVeosErr iErr = VEOS_SUCCESS; X TPUidNode pDests, pNode; X LVAL pXFinger; X X /** convert lisp 'uid' vectors to nancy uids **/ X X pDests = nil; X pXFinger = pList; X while (!null(pXFinger)) { X X#ifndef OPTIMAL X if (!IsUidElt(car(pXFinger))) { X iErr = NATIVE_BADTYPE; X break; X } X#endif X iErr = Shell_NewBlock(sizeof(TUidNode), &pNode, "uid-node"); X X if (iErr != VEOS_SUCCESS) X break; X X else{ X /** add new node to list **/ X X pNode->pNext = pDests; X pDests = pNode; X X X /** convert addr to internal format **/ X X iErr = XVect2Uid(car(pXFinger), &pNode->addr); X } X X pXFinger = cdr(pXFinger); X X } /* while */ X X if (iErr == VEOS_SUCCESS) X *hDests = pDests; X else X Native_DisposeUids(pDests); X X return(iErr); X X } /* Native_XVectsToUids */ X/****************************************************************************************/ X X X X/****************************************************************************************/ XTVeosErr Native_DisposeUids(pDests) X TPUidNode pDests; X{ X TPUidNode pSave; X X while (pDests) { X X pSave = pDests->pNext; X Shell_ReturnBlock(pDests, sizeof(TUidNode), "uid-node"); X pDests = pSave; X } X X return(VEOS_SUCCESS); X X } /* Native_DisposeUids */ X/****************************************************************************************/ X X X/****************************************************************************************/ XTVeosErr IsIntStr(sSrc) X char *sSrc; X{ X TVeosErr iErr; X X iErr = VEOS_FAILURE; X if (sSrc) { X X for (iErr = VEOS_SUCCESS; X sSrc[0] != '\0' && iErr == VEOS_SUCCESS; X sSrc ++) X X if (!isdigit(sSrc[0])) X iErr = VEOS_FAILURE; X } X X return(iErr); X X } /* IsIntStr */ X/****************************************************************************************/ X X END_OF_FILE if test 43094 -ne `wc -c <'kernel_private/src/shell/xv_glutils.c'`; then echo shar: \"'kernel_private/src/shell/xv_glutils.c'\" unpacked with wrong size! fi # end of 'kernel_private/src/shell/xv_glutils.c' fi echo shar: End of archive 15 \(of 16\). cp /dev/null ark15isdone MISSING="" for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 ; do if test ! -f ark${I}isdone ; then MISSING="${MISSING} ${I}" fi done if test "${MISSING}" = "" ; then echo You have unpacked all 16 archives. rm -f ark[1-9]isdone ark[1-9][0-9]isdone else echo You still need to unpack the following archives: echo " " ${MISSING} fi ## End of shell archive. exit 0