自学教程：C++ stackPopPtr函数代码示例

/**************************************************************************                        s e a r c h - w o r d l i s t** SEARCH ( c-addr u wid -- 0 | xt 1 | xt -1 )** Find the definition identified by the string c-addr u in the word list** identified by wid. If the definition is not found, return zero. If the** definition is found, return its execution token xt and one (1) if the** definition is immediate, minus-one (-1) otherwise. **************************************************************************/static void searchWordlist(FICL_VM *pVM){    STRINGINFO si;    UNS16 hashCode;    FICL_WORD *pFW;    FICL_HASH *pHash = stackPopPtr(pVM->pStack);    si.count         = (FICL_COUNT)stackPopUNS(pVM->pStack);    si.cp            = stackPopPtr(pVM->pStack);    hashCode         = hashHashCode(si);    ficlLockDictionary(TRUE);    pFW = hashLookup(pHash, si, hashCode);    ficlLockDictionary(FALSE);    if (pFW)    {        stackPushPtr(pVM->pStack, pFW);        stackPushINT(pVM->pStack, (wordIsImmediate(pFW) ? 1 : -1));    }    else    {        stackPushUNS(pVM->pStack, 0);    }    return;}

static void ficlWriteFile(FICL_VM *pVM) /* ( c-addr u1 fileid -- ior ) */{    ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);    int length = stackPopINT(pVM->pStack);    void *address = (void *)stackPopPtr(pVM->pStack);    clearerr(ff->f);    fwrite(address, 1, length, ff->f);    pushIor(pVM, ferror(ff->f) == 0);}

static void ficlWriteLine(FICL_VM *pVM) /* ( c-addr u1 fileid -- ior ) */{    ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);    size_t length = (size_t)stackPopINT(pVM->pStack);    void *address = (void *)stackPopPtr(pVM->pStack);    clearerr(ff->f);    if (fwrite(address, 1, length, ff->f) == length)        fwrite("/n", 1, 1, ff->f);    pushIor(pVM, ferror(ff->f) == 0);}

/**************************************************************************                        setParentWid** FICL** setparentwid   ( parent-wid wid -- )** Set WID's link field to the parent-wid. search-wordlist will ** iterate through all the links when finding words in the child wid.**************************************************************************/static void setParentWid(FICL_VM *pVM){    FICL_HASH *parent, *child;#if FICL_ROBUST > 1    vmCheckStack(pVM, 2, 0);#endif    child  = (FICL_HASH *)stackPopPtr(pVM->pStack);    parent = (FICL_HASH *)stackPopPtr(pVM->pStack);    child->link = parent;    return;}

static void ficlReadFile(FICL_VM *pVM) /* ( c-addr u1 fileid -- u2 ior ) */{    ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);    int length = stackPopINT(pVM->pStack);    void *address = (void *)stackPopPtr(pVM->pStack);    int result;    clearerr(ff->f);    result = fread(address, 1, length, ff->f);    stackPushINT(pVM->pStack, result);    pushIor(pVM, ferror(ff->f) == 0);}

voidficlUnsetenv(FICL_VM *pVM){#ifndef TESTMAIN	char	*name;#endif	char	*namep;	int	names;#if FICL_ROBUST > 1	vmCheckStack(pVM, 2, 0);#endif	names = stackPopINT(pVM->pStack);	namep = (char*) stackPopPtr(pVM->pStack);#ifndef TESTMAIN	name = (char*) ficlMalloc(names+1);	if (!name)		vmThrowErr(pVM, "Error: out of memory");	strncpy(name, namep, names);	name[names] = '/0';	unsetenv(name);	ficlFree(name);#endif	return;}

voidficlGetenv(FICL_VM *pVM){#ifndef TESTMAIN	char	*name;#endif	char	*namep, *value;	int	names;#if FICL_ROBUST > 1	vmCheckStack(pVM, 2, 2);#endif	names = stackPopINT(pVM->pStack);	namep = (char*) stackPopPtr(pVM->pStack);#ifndef TESTMAIN	name = (char*) ficlMalloc(names+1);	if (!name)		vmThrowErr(pVM, "Error: out of memory");	strncpy(name, namep, names);	name[names] = '/0';	value = getenv(name);	ficlFree(name);	if(value != NULL) {		stackPushPtr(pVM->pStack, value);		stackPushINT(pVM->pStack, strlen(value));	} else#endif		stackPushINT(pVM->pStack, -1);	return;}

/**************************************************************************                        s e t - o r d e r** SEARCH ( widn ... wid1 n -- )** Set the search order to the word lists identified by widn ... wid1.** Subsequently, word list wid1 will be searched first, and word list** widn searched last. If n is zero, empty the search order. If n is minus** one, set the search order to the implementation-defined minimum** search order. The minimum search order shall include the words** FORTH-WORDLIST and SET-ORDER. A system shall allow n to** be at least eight.**************************************************************************/static void setOrder(FICL_VM *pVM){    int i;    int nLists = stackPopINT(pVM->pStack);    FICL_DICT *dp = vmGetDict(pVM);    if (nLists > FICL_DEFAULT_VOCS)    {        vmThrowErr(pVM, "set-order error: list would be too large");    }    ficlLockDictionary(TRUE);    if (nLists >= 0)    {        dp->nLists = nLists;        for (i = nLists-1; i >= 0; --i)        {            dp->pSearch[i] = stackPopPtr(pVM->pStack);        }    }    else    {        dictResetSearchOrder(dp);    }    ficlLockDictionary(FALSE);    return;}

voidficlUuidToString(FICL_VM *pVM){#ifndef	TESTMAIN	char	*uuid;	uint32_t status;#endif	uuid_t	*u;#if FICL_ROBUST > 1	vmCheckStack(pVM, 1, 0);#endif	u = (uuid_t *)stackPopPtr(pVM->pStack);#ifndef	TESTMAIN	uuid_to_string(u, &uuid, &status);	if (status != uuid_s_ok) {		stackPushPtr(pVM->pStack, uuid);		stackPushINT(pVM->pStack, strlen(uuid));	} else#endif		stackPushINT(pVM->pStack, -1);	return;}

voidficlCcall(FICL_VM *pVM){	int (*func)(int, ...);	int result, p[10];	int nparam, i;#if FICL_ROBUST > 1	vmCheckStack(pVM, 2, 0);#endif	func = stackPopPtr(pVM->pStack);	nparam = stackPopINT(pVM->pStack);#if FICL_ROBUST > 1	vmCheckStack(pVM, nparam, 1);#endif	for (i = 0; i < nparam; i++)		p[i] = stackPopINT(pVM->pStack);	result = func(p[0], p[1], p[2], p[3], p[4], p[5], p[6], p[7], p[8],	    p[9]);	stackPushINT(pVM->pStack, result);	return;}

static void ficlFileSize(FICL_VM *pVM) /* ( fileid -- ud ior ) */{    ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);    long ud = fileSize(ff->f);    stackPushINT(pVM->pStack, ud);    pushIor(pVM, ud != -1);}

static void ficlRepositionFile(FICL_VM *pVM) /* ( ud fileid -- ior ) */{    ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);    size_t ud = (size_t)stackPopINT(pVM->pStack);    pushIor(pVM, fseek(ff->f, ud, SEEK_SET) == 0);}

static void ficlFileStatus(FICL_VM *pVM) /* ( c-addr u -- x ior ) */{    struct stat statbuf;    int length = stackPopINT(pVM->pStack);    void *address = (void *)stackPopPtr(pVM->pStack);    char *filename = (char *)alloca(length + 1);    memcpy(filename, address, length);    filename[length] = 0;    if (stat(filename, &statbuf) == 0)    {        /*        ** the "x" left on the stack is implementation-defined.        ** I push the file's access mode (readable, writeable, is directory, etc)        ** as defined by ANSI C.        */        stackPushINT(pVM->pStack, statbuf.st_mode);        stackPushINT(pVM->pStack, 0);    }    else    {        stackPushINT(pVM->pStack, -1);        stackPushINT(pVM->pStack, ENOENT);    }}

static void ficlResizeFile(FICL_VM *pVM) /* ( ud fileid -- ior ) */{    ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);    size_t ud = (size_t)stackPopINT(pVM->pStack);    pushIor(pVM, ftruncate(fileno(ff->f), ud) == 0);}

/*          fopen - open a file and return new fd on stack. * * fopen ( ptr count mode -- fd ) */static void pfopen(FICL_VM *pVM){    int     mode, fd, count;    char    *ptr, *name;#if FICL_ROBUST > 1    vmCheckStack(pVM, 3, 1);#endif    mode = stackPopINT(pVM->pStack);    /* get mode */    count = stackPopINT(pVM->pStack);   /* get count */    ptr = stackPopPtr(pVM->pStack);     /* get ptr */    if ((count < 0) || (ptr == NULL)) {        stackPushINT(pVM->pStack, -1);        return;    }    /* ensure that the string is null terminated */    name = (char *)malloc(count+1);    bcopy(ptr,name,count);    name[count] = 0;    /* open the file */    fd = open(name, mode);    free(name);    stackPushINT(pVM->pStack, fd);    return;}

/*** Here's the outer part of the decompiler. It's ** just a big nested conditional that checks the** CFA of the word to decompile for each kind of** known word-builder code, and tries to do ** something appropriate. If the CFA is not recognized,** just indicate that it is a primitive.*/static void seeXT(FICL_VM *pVM){    FICL_WORD *pFW;    WORDKIND kind;    pFW = (FICL_WORD *)stackPopPtr(pVM->pStack);    kind = ficlWordClassify(pFW);    switch (kind)    {    case COLON:        sprintf(pVM->pad, ": %.*s", pFW->nName, pFW->name);        vmTextOut(pVM, pVM->pad, 1);        seeColon(pVM, pFW->param);        break;    case DOES:        vmTextOut(pVM, "does>", 1);        seeColon(pVM, (CELL *)pFW->param->p);        break;    case CREATE:        vmTextOut(pVM, "create", 1);        break;    case VARIABLE:        sprintf(pVM->pad, "variable = %ld (%#lx)", pFW->param->i, pFW->param->u);        vmTextOut(pVM, pVM->pad, 1);        break;#if FICL_WANT_USER    case USER:        sprintf(pVM->pad, "user variable %ld (%#lx)", pFW->param->i, pFW->param->u);        vmTextOut(pVM, pVM->pad, 1);        break;#endif    case CONSTANT:        sprintf(pVM->pad, "constant = %ld (%#lx)", pFW->param->i, pFW->param->u);        vmTextOut(pVM, pVM->pad, 1);    default:        sprintf(pVM->pad, "%.*s is a primitive", pFW->nName, pFW->name);        vmTextOut(pVM, pVM->pad, 1);        break;    }    if (pFW->flags & FW_IMMEDIATE)    {        vmTextOut(pVM, "immediate", 1);    }    if (pFW->flags & FW_COMPILE)    {        vmTextOut(pVM, "compile-only", 1);    }    return;}

/**************************************************************************                        s e t - c u r r e n t** SEARCH ( wid -- )** Set the compilation word list to the word list identified by wid. **************************************************************************/static void setCurrent(FICL_VM *pVM){    FICL_HASH *pHash = stackPopPtr(pVM->pStack);    FICL_DICT *pDict = vmGetDict(pVM);    ficlLockDictionary(TRUE);    pDict->pCompile = pHash;    ficlLockDictionary(FALSE);    return;}

static void ficlDeleteFile(FICL_VM *pVM) /* ( c-addr u -- ior ) */{    int length = stackPopINT(pVM->pStack);    void *address = (void *)stackPopPtr(pVM->pStack);    char *filename = (char *)alloca(length + 1);    memcpy(filename, address, length);    filename[length] = 0;    pushIor(pVM, !unlink(filename));}

static void execxt(FICL_VM *pVM){    FICL_WORD *pFW;#if FICL_ROBUST > 1    vmCheckStack(pVM, 1, 0);#endif    pFW = stackPopPtr(pVM->pStack);    ficlExecXT(pVM, pFW);    return;}

static void ficlRenameFile(FICL_VM *pVM) /* ( c-addr1 u1 c-addr2 u2 -- ior ) */{    int length;    void *address;    char *from;    char *to;    length = stackPopINT(pVM->pStack);    address = (void *)stackPopPtr(pVM->pStack);    to = (char *)alloca(length + 1);    memcpy(to, address, length);    to[length] = 0;    length = stackPopINT(pVM->pStack);    address = (void *)stackPopPtr(pVM->pStack);    from = (char *)alloca(length + 1);    memcpy(from, address, length);    from[length] = 0;    pushIor(pVM, !rename(from, to));}

/**************************************************************************                        > S E A R C H** ficl  ( wid -- )** Push wid onto the search order. Error if the search order is full.**************************************************************************/static void searchPush(FICL_VM *pVM){    FICL_DICT *dp = vmGetDict(pVM);    ficlLockDictionary(TRUE);    if (dp->nLists > FICL_DEFAULT_VOCS)    {        vmThrowErr(pVM, ">search error: search order overflow");    }    dp->pSearch[dp->nLists++] = stackPopPtr(pVM->pStack);    ficlLockDictionary(FALSE);    return;}

static void ficlReadLine(FICL_VM *pVM) /* ( c-addr u1 fileid -- u2 flag ior ) */{    ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);    int length = stackPopINT(pVM->pStack);    char *address = (char *)stackPopPtr(pVM->pStack);    int error;    int flag;    if (feof(ff->f))        {        stackPushINT(pVM->pStack, -1);        stackPushINT(pVM->pStack, 0);        stackPushINT(pVM->pStack, 0);        return;        }    clearerr(ff->f);    *address = 0;    fgets(address, length, ff->f);    error = ferror(ff->f);    if (error != 0)        {        stackPushINT(pVM->pStack, -1);        stackPushINT(pVM->pStack, 0);        stackPushINT(pVM->pStack, error);        return;        }    length = strlen(address);    flag = (length > 0);    if (length && ((address[length - 1] == '/r') || (address[length - 1] == '/n')))        length--;        stackPushINT(pVM->pStack, length);    stackPushINT(pVM->pStack, flag);    stackPushINT(pVM->pStack, 0); /* ior */}

voidficlFindfile(FICL_VM *pVM){#ifndef TESTMAIN	char	*name;#endif	char	*type, *namep, *typep;	struct	preloaded_file* fp;	int	names, types;#if FICL_ROBUST > 1	vmCheckStack(pVM, 4, 1);#endif	types = stackPopINT(pVM->pStack);	typep = (char*) stackPopPtr(pVM->pStack);	names = stackPopINT(pVM->pStack);	namep = (char*) stackPopPtr(pVM->pStack);#ifndef TESTMAIN	name = (char*) ficlMalloc(names+1);	if (!name)		vmThrowErr(pVM, "Error: out of memory");	strncpy(name, namep, names);	name[names] = '/0';	type = (char*) ficlMalloc(types+1);	if (!type)		vmThrowErr(pVM, "Error: out of memory");	strncpy(type, typep, types);	type[types] = '/0';	fp = file_findfile(name, type);#else	fp = NULL;#endif	stackPushPtr(pVM->pStack, fp);	return;}

voidficlSetenvq(FICL_VM *pVM){#ifndef TESTMAIN	char	*name, *value;#endif	char	*namep, *valuep;	int	names, values, overwrite;#if FICL_ROBUST > 1	vmCheckStack(pVM, 5, 0);#endif	overwrite = stackPopINT(pVM->pStack);	names = stackPopINT(pVM->pStack);	namep = (char*) stackPopPtr(pVM->pStack);	values = stackPopINT(pVM->pStack);	valuep = (char*) stackPopPtr(pVM->pStack);#ifndef TESTMAIN	name = (char*) ficlMalloc(names+1);	if (!name)		vmThrowErr(pVM, "Error: out of memory");	strncpy(name, namep, names);	name[names] = '/0';	value = (char*) ficlMalloc(values+1);	if (!value)		vmThrowErr(pVM, "Error: out of memory");	strncpy(value, valuep, values);	value[values] = '/0';	setenv(name, value, overwrite);	ficlFree(name);	ficlFree(value);#endif	return;}

static void ficlFopen(FICL_VM *pVM, char *writeMode) /* ( c-addr u fam -- fileid ior ) */{    int fam = stackPopINT(pVM->pStack);    int length = stackPopINT(pVM->pStack);    void *address = (void *)stackPopPtr(pVM->pStack);    char mode[4];    FILE *f;    char *filename = (char *)alloca(length + 1);    memcpy(filename, address, length);    filename[length] = 0;    *mode = 0;    switch (FICL_FAM_OPEN_MODE(fam))        {        case 0:            stackPushPtr(pVM->pStack, NULL);            stackPushINT(pVM->pStack, EINVAL);            return;        case FICL_FAM_READ:            strcat(mode, "r");            break;        case FICL_FAM_WRITE:            strcat(mode, writeMode);            break;        case FICL_FAM_READ | FICL_FAM_WRITE:            strcat(mode, writeMode);            strcat(mode, "+");            break;        }    strcat(mode, (fam & FICL_FAM_BINARY) ? "b" : "t");    f = fopen(filename, mode);    if (f == NULL)        stackPushPtr(pVM->pStack, NULL);    else        {        ficlFILE *ff = (ficlFILE *)malloc(sizeof(ficlFILE));        strcpy(ff->filename, filename);        ff->f = f;        stackPushPtr(pVM->pStack, ff);        fseek(f, 0, SEEK_SET);        }    pushIor(pVM, f != NULL);}

/*          fwrite - write file contents * * fwrite  ( fd buf nbytes  -- nwritten ) */static void pfwrite(FICL_VM *pVM){    int     fd, len;    char *buf;#if FICL_ROBUST > 1    vmCheckStack(pVM, 3, 1);#endif    len = stackPopINT(pVM->pStack); /* get number of bytes to read */    buf = stackPopPtr(pVM->pStack); /* get buffer */    fd = stackPopINT(pVM->pStack); /* get fd */    if (len > 0 && buf && fd != -1)	stackPushINT(pVM->pStack, write(fd, buf, len));    else	stackPushINT(pVM->pStack, -1);    return;}

voidficlUuidFromString(FICL_VM *pVM){#ifndef	TESTMAIN	char	*uuid;	uint32_t status;#endif	char	*uuidp;	int	uuids;	uuid_t	*u;#if FICL_ROBUST > 1	vmCheckStack(pVM, 2, 0);#endif	uuids = stackPopINT(pVM->pStack);	uuidp = (char *) stackPopPtr(pVM->pStack);#ifndef	TESTMAIN	uuid = (char *)ficlMalloc(uuids + 1);	if (!uuid)		vmThrowErr(pVM, "Error: out of memory");	strncpy(uuid, uuidp, uuids);	uuid[uuids] = '/0';	u = (uuid_t *)ficlMalloc(sizeof (*u));	uuid_from_string(uuid, u, &status);	ficlFree(uuid);	if (status != uuid_s_ok) {		ficlFree(u);		u = NULL;	}#else	u = NULL;#endif	stackPushPtr(pVM->pStack, u);	return;}

voidficlCopyout(FICL_VM *pVM){	void*		dest;	vm_offset_t	src;	size_t		len;#if FICL_ROBUST > 1	vmCheckStack(pVM, 3, 0);#endif	len = stackPopINT(pVM->pStack);	dest = stackPopPtr(pVM->pStack);	src = stackPopINT(pVM->pStack);#ifndef TESTMAIN	archsw.arch_copyout(src, dest, len);#endif	return;}

void stackUnlink(FICL_STACK *pStack){    pStack->sp = pStack->pFrame;    pStack->pFrame = stackPopPtr(pStack);    return;}