Deleted Added
sdiff udiff text old ( 43135 ) new ( 43139 )
full compact
1/*******************************************************************
2** w o r d s . c
3** Forth Inspired Command Language
4** ANS Forth CORE word-set written in C
5** Author: John Sadler (john_sadler@alum.mit.edu)
6** Created: 19 July 1997
7**
8*******************************************************************/

--- 1054 unchanged lines hidden (view full) ---

1063
1064/**************************************************************************
1065 i f P a r e n
1066** Runtime code to do "if" or "until": pop a flag from the stack,
1067** fall through if true, branch if false. Probably ought to be
1068** called (not?branch) since it does "branch if false".
1069**************************************************************************/
1070
1071#ifdef FICL_TRACE
1072void ifParen(FICL_VM *pVM)
1073#else
1074static void ifParen(FICL_VM *pVM)
1075#endif
1076{
1077 UNS32 flag;
1078
1079#if FICL_ROBUST > 1
1080 vmCheckStack(pVM, 1, 0);
1081#endif
1082 flag = stackPopUNS32(pVM->pStack);
1083

--- 45 unchanged lines hidden (view full) ---

1129
1130/**************************************************************************
1131 b r a n c h P a r e n
1132**
1133** Runtime for "(branch)" -- expects a literal offset in the next
1134** compilation address, and branches to that location.
1135**************************************************************************/
1136
1137#ifdef FICL_TRACE
1138void branchParen(FICL_VM *pVM)
1139#else
1140static void branchParen(FICL_VM *pVM)
1141#endif
1142{
1143 vmBranchRelative(pVM, *(int *)(pVM->ip));
1144 return;
1145}
1146
1147
1148/**************************************************************************
1149 e n d i f C o I m

--- 130 unchanged lines hidden (view full) ---

1280/**************************************************************************
1281 l i t e r a l P a r e n
1282**
1283** This is the runtime for (literal). It assumes that it is part of a colon
1284** definition, and that the next CELL contains a value to be pushed on the
1285** parameter stack at runtime. This code is compiled by "literal".
1286**
1287**************************************************************************/
1280
1288#ifdef FICL_TRACE
1289void literalParen(FICL_VM *pVM)
1290#else
1291static void literalParen(FICL_VM *pVM)
1292#endif
1293{
1294#if FICL_ROBUST > 1
1295 vmCheckStack(pVM, 0, 1);
1296#endif
1297 stackPushINT32(pVM->pStack, *(INT32 *)(pVM->ip));
1298 vmBranchRelative(pVM, 1);
1299 return;
1300}

--- 296 unchanged lines hidden (view full) ---

1597 /*
1598 ** Mark location of head of loop...
1599 */
1600 markBranch(dp, pVM, doTag);
1601
1602 return;
1603}
1604
1594
1605#ifdef FICL_TRACE
1606void doParen(FICL_VM *pVM)
1607#else
1608static void doParen(FICL_VM *pVM)
1609#endif
1610{
1611 CELL index, limit;
1612#if FICL_ROBUST > 1
1613 vmCheckStack(pVM, 2, 0);
1614#endif
1615 index = stackPop(pVM->pStack);
1616 limit = stackPop(pVM->pStack);
1617

--- 22 unchanged lines hidden (view full) ---

1640 /*
1641 ** Mark location of head of loop...
1642 */
1643 markBranch(dp, pVM, doTag);
1644
1645 return;
1646}
1647
1634
1648#ifdef FICL_TRACE
1649void qDoParen(FICL_VM *pVM)
1650#else
1651static void qDoParen(FICL_VM *pVM)
1652#endif
1653{
1654 CELL index, limit;
1655#if FICL_ROBUST > 1
1656 vmCheckStack(pVM, 2, 0);
1657#endif
1658 index = stackPop(pVM->pStack);
1659 limit = stackPop(pVM->pStack);
1660

--- 56 unchanged lines hidden (view full) ---

1717 assert(pPLoopParen);
1718
1719 dictAppendCell(dp, LVALUEtoCELL(pPLoopParen));
1720 resolveBackBranch(dp, pVM, doTag);
1721 resolveAbsBranch(dp, pVM, leaveTag);
1722 return;
1723}
1724
1708
1725#ifdef FICL_TRACE
1726void loopParen(FICL_VM *pVM)
1727#else
1728static void loopParen(FICL_VM *pVM)
1729#endif
1730{
1731 INT32 index = stackGetTop(pVM->rStack).i;
1732 INT32 limit = stackFetch(pVM->rStack, 1).i;
1733
1734 index++;
1735
1736 if (index >= limit)
1737 {

--- 4 unchanged lines hidden (view full) ---

1742 { /* update index, branch to loop head */
1743 stackSetTop(pVM->rStack, LVALUEtoCELL(index));
1744 vmBranchRelative(pVM, *(int *)(pVM->ip));
1745 }
1746
1747 return;
1748}
1749
1730
1750#ifdef FICL_TRACE
1751void plusLoopParen(FICL_VM *pVM)
1752#else
1753static void plusLoopParen(FICL_VM *pVM)
1754#endif
1755{
1756 INT32 index = stackGetTop(pVM->rStack).i;
1757 INT32 limit = stackFetch(pVM->rStack, 1).i;
1758 INT32 increment = stackPop(pVM->pStack).i;
1759 int flag;
1760
1761 index += increment;
1762

--- 289 unchanged lines hidden (view full) ---

2052** IMMEDIATE word that compiles a string literal for later display
2053** Compile stringLit, then copy the bytes of the string from the TIB
2054** to the dictionary. Backpatch the count byte and align the dictionary.
2055**
2056** stringlit: Fetch the count from the dictionary, then push the address
2057** and count on the stack. Finally, update ip to point to the first
2058** aligned address after the string text.
2059**************************************************************************/
2037
2060#ifdef FICL_TRACE
2061void stringLit(FICL_VM *pVM)
2062#else
2063static void stringLit(FICL_VM *pVM)
2064#endif
2065{
2066 FICL_STRING *sp = (FICL_STRING *)(pVM->ip);
2067 FICL_COUNT count = sp->count;
2068 char *cp = sp->text;
2069 stackPushPtr(pVM->pStack, cp);
2070 stackPushUNS32(pVM->pStack, count);
2071 cp += count + 1;
2072 cp = alignPtr(cp);

--- 1731 unchanged lines hidden (view full) ---

3804/*
3805** isAFiclWord
3806** Vet a candidate pointer carefully to make sure
3807** it's not some chunk o' inline data...
3808** It has to have a name, and it has to look
3809** like it's in the dictionary address range.
3810** NOTE: this excludes :noname words!
3811*/
3812#ifdef FICL_TRACE
3813int isAFiclWord(FICL_WORD *pFW)
3814#else
3815static int isAFiclWord(FICL_WORD *pFW)
3816#endif
3817{
3818 void *pv = (void *)pFW;
3819 FICL_DICT *pd = ficlGetDict();
3820
3821 if (!dictIncludes(pd, pFW))
3822 return 0;
3823
3824 if (!dictIncludes(pd, pFW->name))

--- 601 unchanged lines hidden (view full) ---

4426 vmCheckStack(pVM, 1, 1);
4427#endif
4428 fd = stackPopINT32(pVM->pStack);
4429 i = read(fd, &ch, 1);
4430 stackPushINT32(pVM->pStack, i > 0 ? ch : -1);
4431 return;
4432}
4433
4434/************************* freebsd added trace ***************************/
4435
4436#ifdef FICL_TRACE
4437static void ficlTrace(FICL_VM *pVM)
4438{
4439#if FICL_ROBUST > 1
4440 vmCheckStack(pVM, 1, 1);
4441#endif
4442
4443 ficl_trace = stackPopINT32(pVM->pStack);
4444}
4445#endif
4446
4447/**************************************************************************
4448 f i c l C o m p i l e C o r e
4449** Builds the primitive wordset and the environment-query namespace.
4450**************************************************************************/
4451
4452void ficlCompileCore(FICL_DICT *dp)
4453{
4454 assert (dp);

--- 156 unchanged lines hidden (view full) ---

4611 dictAppendWord(dp, "fclose", pfclose, FW_DEFAULT);
4612 dictAppendWord(dp, "fread", pfread, FW_DEFAULT);
4613 dictAppendWord(dp, "fload", pfload, FW_DEFAULT);
4614 dictAppendWord(dp, "fkey", fkey, FW_DEFAULT);
4615 dictAppendWord(dp, "key", key, FW_DEFAULT);
4616 dictAppendWord(dp, "key?", keyQuestion, FW_DEFAULT);
4617 dictAppendWord(dp, "ms", ms, FW_DEFAULT);
4618 dictAppendWord(dp, "seconds", pseconds, FW_DEFAULT);
4619#ifdef FICL_TRACE
4620 dictAppendWord(dp, "trace!", ficlTrace, FW_DEFAULT);
4621#endif
4622 /*
4623 ** EXCEPTION word set
4624 */
4625 dictAppendWord(dp, "catch", catch, FW_DEFAULT);
4626 dictAppendWord(dp, "throw", throw, FW_DEFAULT);
4627
4628 ficlSetEnv("exception", FICL_TRUE);
4629 ficlSetEnv("exception-ext", FICL_TRUE);

--- 172 unchanged lines hidden ---