Deleted Added
sdiff udiff text old ( 108470 ) new ( 167850 )
full compact
words.c (108470) words.c (167850)
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** $Id: words.c,v 1.17 2001/12/05 07:21:34 jsadler Exp $
8*******************************************************************/

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

36** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
37** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
38** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
39** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
40** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
41** SUCH DAMAGE.
42*/
43
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** $Id: words.c,v 1.17 2001/12/05 07:21:34 jsadler Exp $
8*******************************************************************/

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

36** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
37** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
38** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
39** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
40** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
41** SUCH DAMAGE.
42*/
43
44/* $FreeBSD: head/sys/boot/ficl/words.c 108470 2002-12-30 21:18:15Z schweikh $ */
44/* $FreeBSD: head/sys/boot/ficl/words.c 167850 2007-03-23 22:26:01Z jkim $ */
45
46#ifdef TESTMAIN
47#include <stdlib.h>
48#include <stdio.h>
49#include <ctype.h>
50#include <fcntl.h>
51#else
52#include <stand.h>

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

66*/
67static char doTag[] = "do";
68static char colonTag[] = "colon";
69static char leaveTag[] = "leave";
70
71static char destTag[] = "target";
72static char origTag[] = "origin";
73
45
46#ifdef TESTMAIN
47#include <stdlib.h>
48#include <stdio.h>
49#include <ctype.h>
50#include <fcntl.h>
51#else
52#include <stand.h>

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

66*/
67static char doTag[] = "do";
68static char colonTag[] = "colon";
69static char leaveTag[] = "leave";
70
71static char destTag[] = "target";
72static char origTag[] = "origin";
73
74static char caseTag[] = "case";
75static char ofTag[] = "of";
76static char fallthroughTag[] = "fallthrough";
77
74#if FICL_WANT_LOCALS
75static void doLocalIm(FICL_VM *pVM);
76static void do2LocalIm(FICL_VM *pVM);
77#endif
78
79
80/*
81** C O N T R O L S T R U C T U R E B U I L D E R S

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

1215 vmCheckStack(pVM, 2, 0);
1216#endif
1217 pc = (UNS8 *)stackPopPtr(pVM->pStack);
1218 *pc = (UNS8)(stackPop(pVM->pStack).u);
1219}
1220
1221
1222/**************************************************************************
78#if FICL_WANT_LOCALS
79static void doLocalIm(FICL_VM *pVM);
80static void do2LocalIm(FICL_VM *pVM);
81#endif
82
83
84/*
85** C O N T R O L S T R U C T U R E B U I L D E R S

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

1219 vmCheckStack(pVM, 2, 0);
1220#endif
1221 pc = (UNS8 *)stackPopPtr(pVM->pStack);
1222 *pc = (UNS8)(stackPop(pVM->pStack).u);
1223}
1224
1225
1226/**************************************************************************
1223 i f C o I m
1224** IMMEDIATE
1225** Compiles code for a conditional branch into the dictionary
1226** and pushes the branch patch address on the stack for later
1227** patching by ELSE or THEN/ENDIF.
1227 b r a n c h P a r e n
1228**
1229** Runtime for "(branch)" -- expects a literal offset in the next
1230** compilation address, and branches to that location.
1228**************************************************************************/
1229
1231**************************************************************************/
1232
1230static void ifCoIm(FICL_VM *pVM)
1233static void branchParen(FICL_VM *pVM)
1231{
1234{
1232 FICL_DICT *dp = vmGetDict(pVM);
1233
1234 assert(pVM->pSys->pIfParen);
1235
1236 dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pIfParen));
1237 markBranch(dp, pVM, origTag);
1238 dictAppendUNS(dp, 1);
1235 vmBranchRelative(pVM, (uintptr_t)*(pVM->ip));
1239 return;
1240}
1241
1242
1243/**************************************************************************
1236 return;
1237}
1238
1239
1240/**************************************************************************
1244 i f P a r e n
1245** Runtime code to do "if" or "until": pop a flag from the stack,
1246** fall through if true, branch if false. Probably ought to be
1247** called (not?branch) since it does "branch if false".
1241 b r a n c h 0
1242** Runtime code for "(branch0)"; pop a flag from the stack,
1243** branch if 0. fall through otherwise. The heart of "if" and "until".
1248**************************************************************************/
1249
1244**************************************************************************/
1245
1250static void ifParen(FICL_VM *pVM)
1246static void branch0(FICL_VM *pVM)
1251{
1252 FICL_UNS flag;
1253
1254#if FICL_ROBUST > 1
1255 vmCheckStack(pVM, 1, 0);
1256#endif
1257 flag = stackPopUNS(pVM->pStack);
1258

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

1265 vmBranchRelative(pVM, (uintptr_t)*(pVM->ip));
1266 }
1267
1268 return;
1269}
1270
1271
1272/**************************************************************************
1247{
1248 FICL_UNS flag;
1249
1250#if FICL_ROBUST > 1
1251 vmCheckStack(pVM, 1, 0);
1252#endif
1253 flag = stackPopUNS(pVM->pStack);
1254

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

1261 vmBranchRelative(pVM, (uintptr_t)*(pVM->ip));
1262 }
1263
1264 return;
1265}
1266
1267
1268/**************************************************************************
1269 i f C o I m
1270** IMMEDIATE COMPILE-ONLY
1271** Compiles code for a conditional branch into the dictionary
1272** and pushes the branch patch address on the stack for later
1273** patching by ELSE or THEN/ENDIF.
1274**************************************************************************/
1275
1276static void ifCoIm(FICL_VM *pVM)
1277{
1278 FICL_DICT *dp = vmGetDict(pVM);
1279
1280 assert(pVM->pSys->pBranch0);
1281
1282 dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pBranch0));
1283 markBranch(dp, pVM, origTag);
1284 dictAppendUNS(dp, 1);
1285 return;
1286}
1287
1288
1289/**************************************************************************
1273 e l s e C o I m
1274**
1290 e l s e C o I m
1291**
1275** IMMEDIATE -- compiles an "else"...
1292** IMMEDIATE COMPILE-ONLY
1293** compiles an "else"...
1276** 1) Compile a branch and a patch address; the address gets patched
1277** by "endif" to point past the "else" code.
1278** 2) Pop the the "if" patch address
1279** 3) Patch the "if" branch to point to the current compile address.
1280** 4) Push the "else" patch address. ("endif" patches this to jump past
1281** the "else" code.
1282**************************************************************************/
1283

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

1298 offset = dp->here - patchAddr;
1299 *patchAddr = LVALUEtoCELL(offset); /* (3) Patch "if" */
1300
1301 return;
1302}
1303
1304
1305/**************************************************************************
1294** 1) Compile a branch and a patch address; the address gets patched
1295** by "endif" to point past the "else" code.
1296** 2) Pop the the "if" patch address
1297** 3) Patch the "if" branch to point to the current compile address.
1298** 4) Push the "else" patch address. ("endif" patches this to jump past
1299** the "else" code.
1300**************************************************************************/
1301

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

1316 offset = dp->here - patchAddr;
1317 *patchAddr = LVALUEtoCELL(offset); /* (3) Patch "if" */
1318
1319 return;
1320}
1321
1322
1323/**************************************************************************
1306 b r a n c h P a r e n
1307**
1308** Runtime for "(branch)" -- expects a literal offset in the next
1309** compilation address, and branches to that location.
1324 e n d i f C o I m
1325** IMMEDIATE COMPILE-ONLY
1310**************************************************************************/
1311
1326**************************************************************************/
1327
1312static void branchParen(FICL_VM *pVM)
1328static void endifCoIm(FICL_VM *pVM)
1313{
1329{
1314 vmBranchRelative(pVM, (uintptr_t)*(pVM->ip));
1330 FICL_DICT *dp = vmGetDict(pVM);
1331 resolveForwardBranch(dp, pVM, origTag);
1315 return;
1316}
1317
1318
1319/**************************************************************************
1332 return;
1333}
1334
1335
1336/**************************************************************************
1320 e n d i f C o I m
1321**
1337 c a s e C o I m
1338** IMMEDIATE COMPILE-ONLY
1339**
1340**
1341** At compile-time, a CASE-SYS (see DPANS94 6.2.0873) looks like this:
1342** i*addr i caseTag
1343** and an OF-SYS (see DPANS94 6.2.1950) looks like this:
1344** i*addr i caseTag addr ofTag
1345** The integer under caseTag is the count of fixup addresses that branch
1346** to ENDCASE.
1322**************************************************************************/
1323
1347**************************************************************************/
1348
1324static void endifCoIm(FICL_VM *pVM)
1349static void caseCoIm(FICL_VM *pVM)
1325{
1350{
1351#if FICL_ROBUST > 1
1352 vmCheckStack(pVM, 0, 2);
1353#endif
1354
1355 PUSHUNS(0);
1356 markControlTag(pVM, caseTag);
1357 return;
1358}
1359
1360
1361/**************************************************************************
1362 e n d c a s eC o I m
1363** IMMEDIATE COMPILE-ONLY
1364**************************************************************************/
1365
1366static void endcaseCoIm(FICL_VM *pVM)
1367{
1368 FICL_UNS fixupCount;
1369 FICL_DICT *dp;
1370 CELL *patchAddr;
1371 FICL_INT offset;
1372
1373 assert(pVM->pSys->pDrop);
1374
1375 /*
1376 ** if the last OF ended with FALLTHROUGH,
1377 ** just add the FALLTHROUGH fixup to the
1378 ** ENDOF fixups
1379 */
1380 if (stackGetTop(pVM->pStack).p == fallthroughTag)
1381 {
1382 matchControlTag(pVM, fallthroughTag);
1383 patchAddr = POPPTR();
1384 matchControlTag(pVM, caseTag);
1385 fixupCount = POPUNS();
1386 PUSHPTR(patchAddr);
1387 PUSHUNS(fixupCount + 1);
1388 markControlTag(pVM, caseTag);
1389 }
1390
1391 matchControlTag(pVM, caseTag);
1392
1393#if FICL_ROBUST > 1
1394 vmCheckStack(pVM, 1, 0);
1395#endif
1396 fixupCount = POPUNS();
1397#if FICL_ROBUST > 1
1398 vmCheckStack(pVM, fixupCount, 0);
1399#endif
1400
1401 dp = vmGetDict(pVM);
1402
1403 dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pDrop));
1404
1405 while (fixupCount--)
1406 {
1407 patchAddr = (CELL *)stackPopPtr(pVM->pStack);
1408 offset = dp->here - patchAddr;
1409 *patchAddr = LVALUEtoCELL(offset);
1410 }
1411 return;
1412}
1413
1414
1415static void ofParen(FICL_VM *pVM)
1416{
1417 FICL_UNS a, b;
1418
1419#if FICL_ROBUST > 1
1420 vmCheckStack(pVM, 2, 1);
1421#endif
1422
1423 a = POPUNS();
1424 b = stackGetTop(pVM->pStack).u;
1425
1426 if (a == b)
1427 { /* fall through */
1428 stackDrop(pVM->pStack, 1);
1429 vmBranchRelative(pVM, 1);
1430 }
1431 else
1432 { /* take branch to next of or endswitch */
1433 vmBranchRelative(pVM, *(int *)(pVM->ip));
1434 }
1435
1436 return;
1437}
1438
1439
1440/**************************************************************************
1441 o f C o I m
1442** IMMEDIATE COMPILE-ONLY
1443**************************************************************************/
1444
1445static void ofCoIm(FICL_VM *pVM)
1446{
1326 FICL_DICT *dp = vmGetDict(pVM);
1447 FICL_DICT *dp = vmGetDict(pVM);
1327 resolveForwardBranch(dp, pVM, origTag);
1448 CELL *fallthroughFixup = NULL;
1449
1450 assert(pVM->pSys->pBranch0);
1451
1452#if FICL_ROBUST > 1
1453 vmCheckStack(pVM, 1, 3);
1454#endif
1455
1456 if (stackGetTop(pVM->pStack).p == fallthroughTag)
1457 {
1458 matchControlTag(pVM, fallthroughTag);
1459 fallthroughFixup = POPPTR();
1460 }
1461
1462 matchControlTag(pVM, caseTag);
1463
1464 markControlTag(pVM, caseTag);
1465
1466 dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pOfParen));
1467 markBranch(dp, pVM, ofTag);
1468 dictAppendUNS(dp, 2);
1469
1470 if (fallthroughFixup != NULL)
1471 {
1472 FICL_INT offset = dp->here - fallthroughFixup;
1473 *fallthroughFixup = LVALUEtoCELL(offset);
1474 }
1475
1328 return;
1329}
1330
1331
1332/**************************************************************************
1476 return;
1477}
1478
1479
1480/**************************************************************************
1481 e n d o f C o I m
1482** IMMEDIATE COMPILE-ONLY
1483**************************************************************************/
1484
1485static void endofCoIm(FICL_VM *pVM)
1486{
1487 CELL *patchAddr;
1488 FICL_UNS fixupCount;
1489 FICL_INT offset;
1490 FICL_DICT *dp = vmGetDict(pVM);
1491
1492#if FICL_ROBUST > 1
1493 vmCheckStack(pVM, 4, 3);
1494#endif
1495
1496 assert(pVM->pSys->pBranchParen);
1497
1498 /* ensure we're in an OF, */
1499 matchControlTag(pVM, ofTag);
1500 /* grab the address of the branch location after the OF */
1501 patchAddr = (CELL *)stackPopPtr(pVM->pStack);
1502 /* ensure we're also in a "case" */
1503 matchControlTag(pVM, caseTag);
1504 /* grab the current number of ENDOF fixups */
1505 fixupCount = POPUNS();
1506
1507 /* compile branch runtime */
1508 dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pBranchParen));
1509
1510 /* push a new ENDOF fixup, the updated count of ENDOF fixups, and the caseTag */
1511 PUSHPTR(dp->here);
1512 PUSHUNS(fixupCount + 1);
1513 markControlTag(pVM, caseTag);
1514
1515 /* reserve space for the ENDOF fixup */
1516 dictAppendUNS(dp, 2);
1517
1518 /* and patch the original OF */
1519 offset = dp->here - patchAddr;
1520 *patchAddr = LVALUEtoCELL(offset);
1521}
1522
1523
1524/**************************************************************************
1525 f a l l t h r o u g h C o I m
1526** IMMEDIATE COMPILE-ONLY
1527**************************************************************************/
1528
1529static void fallthroughCoIm(FICL_VM *pVM)
1530{
1531 CELL *patchAddr;
1532 FICL_INT offset;
1533 FICL_DICT *dp = vmGetDict(pVM);
1534
1535#if FICL_ROBUST > 1
1536 vmCheckStack(pVM, 4, 3);
1537#endif
1538
1539 /* ensure we're in an OF, */
1540 matchControlTag(pVM, ofTag);
1541 /* grab the address of the branch location after the OF */
1542 patchAddr = (CELL *)stackPopPtr(pVM->pStack);
1543 /* ensure we're also in a "case" */
1544 matchControlTag(pVM, caseTag);
1545
1546 /* okay, here we go. put the case tag back. */
1547 markControlTag(pVM, caseTag);
1548
1549 /* compile branch runtime */
1550 dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pBranchParen));
1551
1552 /* push a new FALLTHROUGH fixup and the fallthroughTag */
1553 PUSHPTR(dp->here);
1554 markControlTag(pVM, fallthroughTag);
1555
1556 /* reserve space for the FALLTHROUGH fixup */
1557 dictAppendUNS(dp, 2);
1558
1559 /* and patch the original OF */
1560 offset = dp->here - patchAddr;
1561 *patchAddr = LVALUEtoCELL(offset);
1562}
1563
1564/**************************************************************************
1333 h a s h
1334** hash ( c-addr u -- code)
1335** calculates hashcode of specified string and leaves it on the stack
1336**************************************************************************/
1337
1338static void hash(FICL_VM *pVM)
1339{
1340 STRINGINFO si;

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

2985 markBranch(dp, pVM, destTag);
2986 return;
2987}
2988
2989static void untilCoIm(FICL_VM *pVM)
2990{
2991 FICL_DICT *dp = vmGetDict(pVM);
2992
1565 h a s h
1566** hash ( c-addr u -- code)
1567** calculates hashcode of specified string and leaves it on the stack
1568**************************************************************************/
1569
1570static void hash(FICL_VM *pVM)
1571{
1572 STRINGINFO si;

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

3217 markBranch(dp, pVM, destTag);
3218 return;
3219}
3220
3221static void untilCoIm(FICL_VM *pVM)
3222{
3223 FICL_DICT *dp = vmGetDict(pVM);
3224
2993 assert(pVM->pSys->pIfParen);
3225 assert(pVM->pSys->pBranch0);
2994
3226
2995 dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pIfParen));
3227 dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pBranch0));
2996 resolveBackBranch(dp, pVM, destTag);
2997 return;
2998}
2999
3000static void whileCoIm(FICL_VM *pVM)
3001{
3002 FICL_DICT *dp = vmGetDict(pVM);
3003
3228 resolveBackBranch(dp, pVM, destTag);
3229 return;
3230}
3231
3232static void whileCoIm(FICL_VM *pVM)
3233{
3234 FICL_DICT *dp = vmGetDict(pVM);
3235
3004 assert(pVM->pSys->pIfParen);
3236 assert(pVM->pSys->pBranch0);
3005
3237
3006 dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pIfParen));
3238 dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pBranch0));
3007 markBranch(dp, pVM, origTag);
3008 twoSwap(pVM);
3009 dictAppendUNS(dp, 1);
3010 return;
3011}
3012
3013static void repeatCoIm(FICL_VM *pVM)
3014{

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

4549 static CODEtoKIND codeMap[] =
4550 {
4551 {BRANCH, branchParen},
4552 {COLON, colonParen},
4553 {CONSTANT, constantParen},
4554 {CREATE, createParen},
4555 {DO, doParen},
4556 {DOES, doDoes},
3239 markBranch(dp, pVM, origTag);
3240 twoSwap(pVM);
3241 dictAppendUNS(dp, 1);
3242 return;
3243}
3244
3245static void repeatCoIm(FICL_VM *pVM)
3246{

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

4781 static CODEtoKIND codeMap[] =
4782 {
4783 {BRANCH, branchParen},
4784 {COLON, colonParen},
4785 {CONSTANT, constantParen},
4786 {CREATE, createParen},
4787 {DO, doParen},
4788 {DOES, doDoes},
4557 {IF, ifParen},
4789 {IF, branch0},
4558 {LITERAL, literalParen},
4559 {LOOP, loopParen},
4790 {LITERAL, literalParen},
4791 {LOOP, loopParen},
4792 {OF, ofParen},
4560 {PLOOP, plusLoopParen},
4561 {QDO, qDoParen},
4562 {CSTRINGLIT, cstringLit},
4563 {STRINGLIT, stringLit},
4564#if FICL_WANT_USER
4565 {USER, userParen},
4566#endif
4567 {VARIABLE, variableParen},

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

4577 if (codeMap[i].code == code)
4578 return codeMap[i].kind;
4579 }
4580
4581 return PRIMITIVE;
4582}
4583
4584
4793 {PLOOP, plusLoopParen},
4794 {QDO, qDoParen},
4795 {CSTRINGLIT, cstringLit},
4796 {STRINGLIT, stringLit},
4797#if FICL_WANT_USER
4798 {USER, userParen},
4799#endif
4800 {VARIABLE, variableParen},

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

4810 if (codeMap[i].code == code)
4811 return codeMap[i].kind;
4812 }
4813
4814 return PRIMITIVE;
4815}
4816
4817
4818#ifdef TESTMAIN
4585/**************************************************************************
4819/**************************************************************************
4820** r a n d o m
4821** FICL-specific
4822**************************************************************************/
4823static void ficlRandom(FICL_VM *pVM)
4824{
4825 PUSHINT(rand());
4826}
4827
4828
4829/**************************************************************************
4830** s e e d - r a n d o m
4831** FICL-specific
4832**************************************************************************/
4833static void ficlSeedRandom(FICL_VM *pVM)
4834{
4835 srand(POPINT());
4836}
4837#endif
4838
4839
4840/**************************************************************************
4586 f i c l C o m p i l e C o r e
4587** Builds the primitive wordset and the environment-query namespace.
4588**************************************************************************/
4589
4590void ficlCompileCore(FICL_SYSTEM *pSys)
4591{
4592 FICL_DICT *dp = pSys->dp;
4593 assert (dp);

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

4646 dictAppendWord(dp, "aligned", aligned, FW_DEFAULT);
4647 dictAppendWord(dp, "allot", allot, FW_DEFAULT);
4648 dictAppendWord(dp, "and", bitwiseAnd, FW_DEFAULT);
4649 dictAppendWord(dp, "base", base, FW_DEFAULT);
4650 dictAppendWord(dp, "begin", beginCoIm, FW_COMPIMMED);
4651 dictAppendWord(dp, "c!", cStore, FW_DEFAULT);
4652 dictAppendWord(dp, "c,", cComma, FW_DEFAULT);
4653 dictAppendWord(dp, "c@", cFetch, FW_DEFAULT);
4841 f i c l C o m p i l e C o r e
4842** Builds the primitive wordset and the environment-query namespace.
4843**************************************************************************/
4844
4845void ficlCompileCore(FICL_SYSTEM *pSys)
4846{
4847 FICL_DICT *dp = pSys->dp;
4848 assert (dp);

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

4901 dictAppendWord(dp, "aligned", aligned, FW_DEFAULT);
4902 dictAppendWord(dp, "allot", allot, FW_DEFAULT);
4903 dictAppendWord(dp, "and", bitwiseAnd, FW_DEFAULT);
4904 dictAppendWord(dp, "base", base, FW_DEFAULT);
4905 dictAppendWord(dp, "begin", beginCoIm, FW_COMPIMMED);
4906 dictAppendWord(dp, "c!", cStore, FW_DEFAULT);
4907 dictAppendWord(dp, "c,", cComma, FW_DEFAULT);
4908 dictAppendWord(dp, "c@", cFetch, FW_DEFAULT);
4909 dictAppendWord(dp, "case", caseCoIm, FW_COMPIMMED);
4654 dictAppendWord(dp, "cell+", cellPlus, FW_DEFAULT);
4655 dictAppendWord(dp, "cells", cells, FW_DEFAULT);
4656 dictAppendWord(dp, "char", ficlChar, FW_DEFAULT);
4657 dictAppendWord(dp, "char+", charPlus, FW_DEFAULT);
4658 dictAppendWord(dp, "chars", ficlChars, FW_DEFAULT);
4659 dictAppendWord(dp, "constant", constant, FW_DEFAULT);
4660 dictAppendWord(dp, "count", count, FW_DEFAULT);
4661 dictAppendWord(dp, "cr", cr, FW_DEFAULT);
4662 dictAppendWord(dp, "create", create, FW_DEFAULT);
4663 dictAppendWord(dp, "decimal", decimal, FW_DEFAULT);
4664 dictAppendWord(dp, "depth", depth, FW_DEFAULT);
4665 dictAppendWord(dp, "do", doCoIm, FW_COMPIMMED);
4666 dictAppendWord(dp, "does>", doesCoIm, FW_COMPIMMED);
4910 dictAppendWord(dp, "cell+", cellPlus, FW_DEFAULT);
4911 dictAppendWord(dp, "cells", cells, FW_DEFAULT);
4912 dictAppendWord(dp, "char", ficlChar, FW_DEFAULT);
4913 dictAppendWord(dp, "char+", charPlus, FW_DEFAULT);
4914 dictAppendWord(dp, "chars", ficlChars, FW_DEFAULT);
4915 dictAppendWord(dp, "constant", constant, FW_DEFAULT);
4916 dictAppendWord(dp, "count", count, FW_DEFAULT);
4917 dictAppendWord(dp, "cr", cr, FW_DEFAULT);
4918 dictAppendWord(dp, "create", create, FW_DEFAULT);
4919 dictAppendWord(dp, "decimal", decimal, FW_DEFAULT);
4920 dictAppendWord(dp, "depth", depth, FW_DEFAULT);
4921 dictAppendWord(dp, "do", doCoIm, FW_COMPIMMED);
4922 dictAppendWord(dp, "does>", doesCoIm, FW_COMPIMMED);
4923 pSys->pDrop =
4667 dictAppendWord(dp, "drop", drop, FW_DEFAULT);
4668 dictAppendWord(dp, "dup", dup, FW_DEFAULT);
4669 dictAppendWord(dp, "else", elseCoIm, FW_COMPIMMED);
4670 dictAppendWord(dp, "emit", emit, FW_DEFAULT);
4924 dictAppendWord(dp, "drop", drop, FW_DEFAULT);
4925 dictAppendWord(dp, "dup", dup, FW_DEFAULT);
4926 dictAppendWord(dp, "else", elseCoIm, FW_COMPIMMED);
4927 dictAppendWord(dp, "emit", emit, FW_DEFAULT);
4928 dictAppendWord(dp, "endcase", endcaseCoIm, FW_COMPIMMED);
4929 dictAppendWord(dp, "endof", endofCoIm, FW_COMPIMMED);
4671 dictAppendWord(dp, "environment?", environmentQ,FW_DEFAULT);
4672 dictAppendWord(dp, "evaluate", evaluate, FW_DEFAULT);
4673 dictAppendWord(dp, "execute", execute, FW_DEFAULT);
4674 dictAppendWord(dp, "exit", exitCoIm, FW_COMPIMMED);
4930 dictAppendWord(dp, "environment?", environmentQ,FW_DEFAULT);
4931 dictAppendWord(dp, "evaluate", evaluate, FW_DEFAULT);
4932 dictAppendWord(dp, "execute", execute, FW_DEFAULT);
4933 dictAppendWord(dp, "exit", exitCoIm, FW_COMPIMMED);
4934 dictAppendWord(dp, "fallthrough",fallthroughCoIm,FW_COMPIMMED);
4675 dictAppendWord(dp, "fill", fill, FW_DEFAULT);
4676 dictAppendWord(dp, "find", cFind, FW_DEFAULT);
4677 dictAppendWord(dp, "fm/mod", fmSlashMod, FW_DEFAULT);
4678 dictAppendWord(dp, "here", here, FW_DEFAULT);
4679 dictAppendWord(dp, "hold", hold, FW_DEFAULT);
4680 dictAppendWord(dp, "i", loopICo, FW_COMPILE);
4681 dictAppendWord(dp, "if", ifCoIm, FW_COMPIMMED);
4682 dictAppendWord(dp, "immediate", immediate, FW_DEFAULT);

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

4688 dictAppendWord(dp, "loop", loopCoIm, FW_COMPIMMED);
4689 dictAppendWord(dp, "lshift", lshift, FW_DEFAULT);
4690 dictAppendWord(dp, "m*", mStar, FW_DEFAULT);
4691 dictAppendWord(dp, "max", ficlMax, FW_DEFAULT);
4692 dictAppendWord(dp, "min", ficlMin, FW_DEFAULT);
4693 dictAppendWord(dp, "mod", ficlMod, FW_DEFAULT);
4694 dictAppendWord(dp, "move", move, FW_DEFAULT);
4695 dictAppendWord(dp, "negate", negate, FW_DEFAULT);
4935 dictAppendWord(dp, "fill", fill, FW_DEFAULT);
4936 dictAppendWord(dp, "find", cFind, FW_DEFAULT);
4937 dictAppendWord(dp, "fm/mod", fmSlashMod, FW_DEFAULT);
4938 dictAppendWord(dp, "here", here, FW_DEFAULT);
4939 dictAppendWord(dp, "hold", hold, FW_DEFAULT);
4940 dictAppendWord(dp, "i", loopICo, FW_COMPILE);
4941 dictAppendWord(dp, "if", ifCoIm, FW_COMPIMMED);
4942 dictAppendWord(dp, "immediate", immediate, FW_DEFAULT);

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

4948 dictAppendWord(dp, "loop", loopCoIm, FW_COMPIMMED);
4949 dictAppendWord(dp, "lshift", lshift, FW_DEFAULT);
4950 dictAppendWord(dp, "m*", mStar, FW_DEFAULT);
4951 dictAppendWord(dp, "max", ficlMax, FW_DEFAULT);
4952 dictAppendWord(dp, "min", ficlMin, FW_DEFAULT);
4953 dictAppendWord(dp, "mod", ficlMod, FW_DEFAULT);
4954 dictAppendWord(dp, "move", move, FW_DEFAULT);
4955 dictAppendWord(dp, "negate", negate, FW_DEFAULT);
4956 dictAppendWord(dp, "of", ofCoIm, FW_COMPIMMED);
4696 dictAppendWord(dp, "or", bitwiseOr, FW_DEFAULT);
4697 dictAppendWord(dp, "over", over, FW_DEFAULT);
4698 dictAppendWord(dp, "postpone", postponeCoIm, FW_COMPIMMED);
4699 dictAppendWord(dp, "quit", quit, FW_DEFAULT);
4700 dictAppendWord(dp, "r>", fromRStack, FW_COMPILE);
4701 dictAppendWord(dp, "r@", fetchRStack, FW_COMPILE);
4702 dictAppendWord(dp, "recurse", recurseCoIm, FW_COMPIMMED);
4703 dictAppendWord(dp, "repeat", repeatCoIm, FW_COMPIMMED);

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

4736 dictAppendWord(dp, "0>", zeroGreater, FW_DEFAULT);
4737 dictAppendWord(dp, "2>r", twoToR, FW_COMPILE);
4738 dictAppendWord(dp, "2r>", twoRFrom, FW_COMPILE);
4739 dictAppendWord(dp, "2r@", twoRFetch, FW_COMPILE);
4740 dictAppendWord(dp, ":noname", colonNoName, FW_DEFAULT);
4741 dictAppendWord(dp, "?do", qDoCoIm, FW_COMPIMMED);
4742 dictAppendWord(dp, "again", againCoIm, FW_COMPIMMED);
4743 dictAppendWord(dp, "c\"", cstringQuoteIm, FW_IMMEDIATE);
4957 dictAppendWord(dp, "or", bitwiseOr, FW_DEFAULT);
4958 dictAppendWord(dp, "over", over, FW_DEFAULT);
4959 dictAppendWord(dp, "postpone", postponeCoIm, FW_COMPIMMED);
4960 dictAppendWord(dp, "quit", quit, FW_DEFAULT);
4961 dictAppendWord(dp, "r>", fromRStack, FW_COMPILE);
4962 dictAppendWord(dp, "r@", fetchRStack, FW_COMPILE);
4963 dictAppendWord(dp, "recurse", recurseCoIm, FW_COMPIMMED);
4964 dictAppendWord(dp, "repeat", repeatCoIm, FW_COMPIMMED);

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

4997 dictAppendWord(dp, "0>", zeroGreater, FW_DEFAULT);
4998 dictAppendWord(dp, "2>r", twoToR, FW_COMPILE);
4999 dictAppendWord(dp, "2r>", twoRFrom, FW_COMPILE);
5000 dictAppendWord(dp, "2r@", twoRFetch, FW_COMPILE);
5001 dictAppendWord(dp, ":noname", colonNoName, FW_DEFAULT);
5002 dictAppendWord(dp, "?do", qDoCoIm, FW_COMPIMMED);
5003 dictAppendWord(dp, "again", againCoIm, FW_COMPIMMED);
5004 dictAppendWord(dp, "c\"", cstringQuoteIm, FW_IMMEDIATE);
4744 /* case of endof endcase */
4745 dictAppendWord(dp, "hex", hex, FW_DEFAULT);
4746 dictAppendWord(dp, "pad", pad, FW_DEFAULT);
4747 dictAppendWord(dp, "parse", parse, FW_DEFAULT);
4748 dictAppendWord(dp, "pick", pick, FW_DEFAULT);
4749 /* query restore-input save-input tib u.r u> unused [compile] */
4750 dictAppendWord(dp, "roll", roll, FW_DEFAULT);
4751 dictAppendWord(dp, "refill", refill, FW_DEFAULT);
4752 dictAppendWord(dp, "source-id", sourceid, FW_DEFAULT);

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

4883 dictAppendWord(dp, "q!", quadStore, FW_DEFAULT);
4884 dictAppendWord(dp, "w@", wFetch, FW_DEFAULT);
4885 dictAppendWord(dp, "w!", wStore, FW_DEFAULT);
4886 dictAppendWord(dp, "x.", hexDot, FW_DEFAULT);
4887#if FICL_WANT_USER
4888 dictAppendWord(dp, "(user)", userParen, FW_DEFAULT);
4889 dictAppendWord(dp, "user", userVariable, FW_DEFAULT);
4890#endif
5005 dictAppendWord(dp, "hex", hex, FW_DEFAULT);
5006 dictAppendWord(dp, "pad", pad, FW_DEFAULT);
5007 dictAppendWord(dp, "parse", parse, FW_DEFAULT);
5008 dictAppendWord(dp, "pick", pick, FW_DEFAULT);
5009 /* query restore-input save-input tib u.r u> unused [compile] */
5010 dictAppendWord(dp, "roll", roll, FW_DEFAULT);
5011 dictAppendWord(dp, "refill", refill, FW_DEFAULT);
5012 dictAppendWord(dp, "source-id", sourceid, FW_DEFAULT);

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

5143 dictAppendWord(dp, "q!", quadStore, FW_DEFAULT);
5144 dictAppendWord(dp, "w@", wFetch, FW_DEFAULT);
5145 dictAppendWord(dp, "w!", wStore, FW_DEFAULT);
5146 dictAppendWord(dp, "x.", hexDot, FW_DEFAULT);
5147#if FICL_WANT_USER
5148 dictAppendWord(dp, "(user)", userParen, FW_DEFAULT);
5149 dictAppendWord(dp, "user", userVariable, FW_DEFAULT);
5150#endif
5151#ifdef TESTMAIN
5152 dictAppendWord(dp, "random", ficlRandom, FW_DEFAULT);
5153 dictAppendWord(dp, "seed-random",ficlSeedRandom,FW_DEFAULT);
5154#endif
4891
4892 /*
4893 ** internal support words
4894 */
4895 dictAppendWord(dp, "(create)", createParen, FW_COMPILE);
4896 pSys->pExitParen =
4897 dictAppendWord(dp, "(exit)", exitParen, FW_COMPILE);
4898 pSys->pSemiParen =
4899 dictAppendWord(dp, "(;)", semiParen, FW_COMPILE);
4900 pSys->pLitParen =
4901 dictAppendWord(dp, "(literal)", literalParen, FW_COMPILE);
4902 pSys->pTwoLitParen =
4903 dictAppendWord(dp, "(2literal)",twoLitParen, FW_COMPILE);
4904 pSys->pStringLit =
4905 dictAppendWord(dp, "(.\")", stringLit, FW_COMPILE);
4906 pSys->pCStringLit =
4907 dictAppendWord(dp, "(c\")", cstringLit, FW_COMPILE);
5155
5156 /*
5157 ** internal support words
5158 */
5159 dictAppendWord(dp, "(create)", createParen, FW_COMPILE);
5160 pSys->pExitParen =
5161 dictAppendWord(dp, "(exit)", exitParen, FW_COMPILE);
5162 pSys->pSemiParen =
5163 dictAppendWord(dp, "(;)", semiParen, FW_COMPILE);
5164 pSys->pLitParen =
5165 dictAppendWord(dp, "(literal)", literalParen, FW_COMPILE);
5166 pSys->pTwoLitParen =
5167 dictAppendWord(dp, "(2literal)",twoLitParen, FW_COMPILE);
5168 pSys->pStringLit =
5169 dictAppendWord(dp, "(.\")", stringLit, FW_COMPILE);
5170 pSys->pCStringLit =
5171 dictAppendWord(dp, "(c\")", cstringLit, FW_COMPILE);
4908 pSys->pIfParen =
4909 dictAppendWord(dp, "(if)", ifParen, FW_COMPILE);
5172 pSys->pBranch0 =
5173 dictAppendWord(dp, "(branch0)", branch0, FW_COMPILE);
4910 pSys->pBranchParen =
4911 dictAppendWord(dp, "(branch)", branchParen, FW_COMPILE);
4912 pSys->pDoParen =
4913 dictAppendWord(dp, "(do)", doParen, FW_COMPILE);
4914 pSys->pDoesParen =
4915 dictAppendWord(dp, "(does>)", doesParen, FW_COMPILE);
4916 pSys->pQDoParen =
4917 dictAppendWord(dp, "(?do)", qDoParen, FW_COMPILE);
4918 pSys->pLoopParen =
4919 dictAppendWord(dp, "(loop)", loopParen, FW_COMPILE);
4920 pSys->pPLoopParen =
4921 dictAppendWord(dp, "(+loop)", plusLoopParen, FW_COMPILE);
4922 pSys->pInterpret =
4923 dictAppendWord(dp, "interpret", interpret, FW_DEFAULT);
4924 dictAppendWord(dp, "lookup", lookup, FW_DEFAULT);
5174 pSys->pBranchParen =
5175 dictAppendWord(dp, "(branch)", branchParen, FW_COMPILE);
5176 pSys->pDoParen =
5177 dictAppendWord(dp, "(do)", doParen, FW_COMPILE);
5178 pSys->pDoesParen =
5179 dictAppendWord(dp, "(does>)", doesParen, FW_COMPILE);
5180 pSys->pQDoParen =
5181 dictAppendWord(dp, "(?do)", qDoParen, FW_COMPILE);
5182 pSys->pLoopParen =
5183 dictAppendWord(dp, "(loop)", loopParen, FW_COMPILE);
5184 pSys->pPLoopParen =
5185 dictAppendWord(dp, "(+loop)", plusLoopParen, FW_COMPILE);
5186 pSys->pInterpret =
5187 dictAppendWord(dp, "interpret", interpret, FW_DEFAULT);
5188 dictAppendWord(dp, "lookup", lookup, FW_DEFAULT);
5189 pSys->pOfParen =
5190 dictAppendWord(dp, "(of)", ofParen, FW_DEFAULT);
4925 dictAppendWord(dp, "(variable)",variableParen, FW_COMPILE);
4926 dictAppendWord(dp, "(constant)",constantParen, FW_COMPILE);
4927 dictAppendWord(dp, "(parse-step)",
4928 parseStepParen, FW_DEFAULT);
4929 pSys->pExitInner =
4930 dictAppendWord(dp, "exit-inner",ficlExitInner, FW_DEFAULT);
4931
4932 /*
4933 ** Set up system's outer interpreter loop - maybe this should be in initSystem?
4934 */
4935 pSys->pInterp[0] = pSys->pInterpret;
4936 pSys->pInterp[1] = pSys->pBranchParen;
4937 pSys->pInterp[2] = (FICL_WORD *)(void *)(-2);
4938
4939 assert(dictCellsAvail(dp) > 0);
4940
4941 return;
4942}
4943
5191 dictAppendWord(dp, "(variable)",variableParen, FW_COMPILE);
5192 dictAppendWord(dp, "(constant)",constantParen, FW_COMPILE);
5193 dictAppendWord(dp, "(parse-step)",
5194 parseStepParen, FW_DEFAULT);
5195 pSys->pExitInner =
5196 dictAppendWord(dp, "exit-inner",ficlExitInner, FW_DEFAULT);
5197
5198 /*
5199 ** Set up system's outer interpreter loop - maybe this should be in initSystem?
5200 */
5201 pSys->pInterp[0] = pSys->pInterpret;
5202 pSys->pInterp[1] = pSys->pBranchParen;
5203 pSys->pInterp[2] = (FICL_WORD *)(void *)(-2);
5204
5205 assert(dictCellsAvail(dp) > 0);
5206
5207 return;
5208}
5209