📄 graspforth.c
字号:
/*1548*/ FETCH,DUP, //?last word in a vocabulary
ZBRANCH,&cfa[1560],
DDUP,NAMET,XOR, //compare
ZBRANCH,&cfa[1560],
CELLM, //continue with next word
BRANCH,&cfa[1548],
/*1560*/ SWAP,DROP,QDUP,
ZBRANCH,&cfa[1542],
SWAP,DROP,SWAP,DROP,SEMI,
/*1570*/ DROP,ZERO,SEMI,
// 1573 .ID ( na -- ) Display the name at address.
_DOCOL,QDUP, //if zero no name
ZBRANCH,&cfa[1583],
COUNT,DOLIT,MASK,AND, //mask lexicon bits
UTYPE,SEMI, //display name string
/*1583*/ DOTQP,
0x6e7b2009, 0x6d614e6f, 0x00007d65, // 9,' {noName}'
SEMI,
// 1588 SEE ( -- ; <string> ) A simple decompiler.
_DOCOL,TICK, //starting address
CR,CELLP,
/*1592*/ CELLP,DUP,FETCH,DUP, //?does it contain a zero
ZBRANCH,&cfa[1599],
TNAME, //?is it a name
/*1599*/ QDUP, //name address or zero
ZBRANCH,&cfa[1606],
SPACE,DOTID, //display name
BRANCH,&cfa[1609],
/*1606*/ DUP,FETCH,UDOT, //display number
/*1609*/ NUFQ, //user control
ZBRANCH,&cfa[1592],
DROP,SEMI,
// 1614 WORDS ( -- ) Display the names in the context vocabulary.
_DOCOL,CR,CONTEXT,FETCH, //only in context
/*1618*/ FETCH,QDUP,NOP,NOP,NOP,NOP,NOP,// //?at end of list,look for null at lfa
ZBRANCH,&cfa[1636],
DUP,SPACE,DOTID, //display a name
CELLM,NUFQ,NOP,
ZBRANCH,&cfa[1618],
DROP,
/*1636*/ SEMI,NOP,
// 1638 CSP ( -- a)
_DOCOL,DOLIT,_CSP,SEMI,
// 1642 UP ( -- a)
_DOCOL,DOLIT,_UP,SEMI,
// 1646 doUSER ( -- a ) Run time routine for user variables.
_DOCOL,RFROM,FETCH,UP,FETCH,ADD,SEMI,
// 1653 VERSION ( -- n ) Return the version number of this implementation.
_DOCOL,DOLIT,80,SEMI,
// 1657 'BOOT ( -- a ) The initial application startup vector.
_DOCOL,DOLIT,_TBOOT,SEMI, //user location TBOOT has vector.
// 1661 hi ( -- ) Display the sign-on message of eForth.
_DOCOL,CR,DOTQP, //initialize I/O
0x6172671d, 0x6f467073, 0x20687472, 0x382e3056, // 29, graspForth V0.80 (c) 2004 BRM
0x63282030, 0x30322029, 0x42203430, 0x00004d52,
CR,SEMI,
// 1674 CONTEXT ( -- a)
_DOCOL,DOLIT,_CONTEXT,SEMI,
// 1678 FORTH ( -- ) Make FORTH the context vocabulary.
_DOCOL,VFRTH,CONTEXT,STORE,SEMI,
// 1683 COLD ( -- ) The hilevel cold start sequence.
_DOCOL,
// 1684 _COLD
PRESET, //initialize data stack and TIB
DECIMAL,
DOLIT,HI,TBOOT,STORE, //initial boot vector
TBOOT,ATEXEC, //application boot
FORTH,CONTEXT,FETCH,DUP, //initialize search order
CURRENT,DSTORE,OVERT,
QUIT, //start interpretation
BRANCH,_COLD //just in case
//----------------------------------------------------------------------------
}; // end of high level colon words.
// ------------------------------- The Dictionary ----------------------------
FORTHDICT dict[] = {
// CFA LFA COUNT NAME
// Compiling words
{ NEXT, 0, 4+COMPO, "next" },
{ DOCOL, &dict[0].count, 5+COMPO, "docol" },
{ SEMI, &dict[1].count, 4, "semi"},
{ DOLIT, &dict[2].count, 5+COMPO, "dolit" },
{ DOCON, &dict[3].count, 5, "docon" },
{ DOCASE, &dict[4].count, 6+COMPO, "docase" },
{ EXECUTE, &dict[5].count, 7, "execute" },
{ ATEXEC, &dict[6].count, 8, "@execute" },
// Branching
{ BRANCH, &dict[7].count, 6+COMPO, "branch" },
{ ZBRANCH, &dict[8].count, 7+COMPO, "zbranch" },
// Memory
{ STORE, &dict[9].count, 1, "!" },
{ PSTORE, &dict[10].count, 2, "+!" },
{ FETCH, &dict[11].count, 1, "@" },
{ CSTORE, &dict[12].count, 2, "c!" },
{ CFETCH, &dict[13].count, 2, "c@" },
// Return Stack
{ RTO , &dict[14].count, 2+COMPO, ">r" },
{ RFROM , &dict[15].count, 2+COMPO, "r>" },
{ RFETCH, &dict[16].count, 2, "r@" },
{ RPZ, &dict[17].count, 3, "rp0" },
{ RPFETCH, &dict[18].count, 3+COMPO, "rp@"},
{ RPSTORE, &dict[19].count, 3+COMPO, "rp!" },
// Parameter Stack
{ SWAP, &dict[20].count, 4, "swap" },
{ DROP, &dict[21].count, 4, "drop" },
{ DUP, &dict[22].count, 3, "dup" },
{ QDUP, &dict[23].count, 4, "?dup" },
{ SPZ, &dict[24].count, 3, "sp0" },
{ NIP, &dict[25].count, 3, "nip" },
{ SPFETCH, &dict[26].count, 3, "sp@" },
{ SPSTORE, &dict[27].count, 3, "sp!" },
{ OVER, &dict[28].count, 4, "over" },
{ ROT, &dict[29].count, 3, "rot" },
// Input/Output
{ TXSTORE, &dict[30].count, 5, "(tx!)" },
{ QRX , &dict[31].count, 5, "(?rx)" },
// Arithmetic
{ ADD , &dict[32].count, 1, "+" },
{ SUB, &dict[33].count, 1, "-" },
{ UADD, &dict[34].count, 2, "u+" },
{ USUB, &dict[35].count, 2, "u-" },
{ MUL, &dict[36].count, 1, "*" },
{ DIV, &dict[37].count, 1, "/" },
{ UMUL, &dict[38].count, 2, "u*" },
{ UDIV, &dict[39].count, 2, "u/" },
{ MULDIV, &dict[40].count, 2, "*/" },
{ UMULDIV, &dict[41].count, 3, "u*/" },
{ TWOMUL, &dict[42].count, 2, "2*" },
{ TWODIV, &dict[43].count, 2, "2/" },
{ LSHIFT, &dict[44].count, 6, "lshift" },
{ RSHIFT, &dict[45].count, 6, "rshift" },
{ ZERO, &dict[46].count, 1, "0" },
{ ONE, &dict[47].count, 1, "1" },
{ TWO, &dict[48].count, 1, "2" },
{ THREE, &dict[49].count, 1, "3" },
{ NONE, &dict[50].count, 2, "-1" },
{ NTWO, &dict[51].count, 2, "-2" },
{ NTHREE, &dict[52].count, 2, "-3" },
{ INVERT, &dict[53].count, 6, "invert" },
{ NEGATE, &dict[54].count, 6, "negate" },
{ MOD, &dict[55].count, 3, "mod" },
{ UMOD, &dict[56].count, 4, "umod" },
// Logical
{ TTRUE, &dict[57].count, 4, "true" },
{ FFALSE, &dict[58].count, 5, "false" },
{ EQ, &dict[59].count, 1, "=" },
{ ZEQ, &dict[60].count, 2, "0=" },
{ LT , &dict[61].count, 1, "<" },
{ ULT, &dict[62].count, 2, "u<" },
{ ZLT, &dict[63].count, 2, "0<" },
{ GT, &dict[64].count, 1, ">" },
{ WITHIN, &dict[65].count, 6, "within" },
{ MAX, &dict[66].count, 3, "max" },
{ MIN, &dict[67].count, 3, "max" },
{ AND, &dict[68].count, 3, "and" },
{ OR, &dict[69].count, 2, "or" },
{ XOR , &dict[70].count, 3, "xor" },
{ NOT, &dict[71].count, 3, "not" },
// Dictionary
{ NAMEQ, &dict[72].count, 5, "name?" },
// Looping
{ DONEXT, &dict[73].count, 6, "donext" },
// System & user variables
{ TQKEY, &dict[74].count, 5, "'?key" },
{ TEMIT, &dict[75].count, 5, "'emit" },
{ TEXPECT, &dict[76].count, 7, "'expect" },
{ TTAP, &dict[77].count, 4, "'tap" },
{ TECHO , &dict[78].count, 5, "'echo" },
{ TPROMPT, &dict[79].count, 7, "'prompt" },
{ TEVAL, &dict[80].count, 5, "'evel" },
{ TNUMBER, &dict[81].count, 7, "'number" },
{ BASE, &dict[82].count, 4, "base" },
{ SPAN, &dict[83].count, 4, "span" },
{ IN, &dict[84].count, 3, ">in" },
{ NTIB, &dict[85].count, 4, "#tib" },
{ HLD, &dict[86].count, 3, "hld" },
{ HANDLER, &dict[87].count, 7, "handler" },
{ CP, &dict[88].count, 2, "cp" },
{ NP, &dict[89].count, 2, "np" },
{ VP, &dict[90].count, 2, "vp" },
{ LAST, &dict[91].count, 4, "last" },
{ VFRTH, &dict[92].count, 7, "(forth)" },
{ CURRENT, &dict[93].count, 7, "current" },
{ USER, &dict[94].count, 2, "up" },
{ TIB, &dict[95].count, 3, "tib" },
// High level colon words
{ EMIT, &dict[96].count, 4, "emit" },
{ QKEY, &dict[97].count, 4, "?key" },
{ KEY , &dict[98].count, 3, "key" },
{ ABS, &dict[99].count, 3, "abs" },
{ CELLP, &dict[100].count, 5, "cell+" },
{ CELLM , &dict[101].count, 5, "cell-" },
{ CELLS, &dict[102].count, 5, "cells" },
{ ALIGNED, &dict[103].count, 7, "aligned" },
{ BLANK, &dict[104].count, 5, "blank" },
{ TOCHAR, &dict[105].count, 5, ">char" },
{ DEPTH, &dict[106].count, 5, "depth" },
{ PICK, &dict[107].count, 4, "pick" },
{ COUNT, &dict[108].count, 5, "count" },
{ HERE, &dict[109].count, 4, "here" },
{ PAD, &dict[110].count, 3, "pad" },
{ CMOVE, &dict[111].count, 5, "cmove" },
{ FILL, &dict[112].count, 4, "fill" },
{ NTRAIL, &dict[113].count, 9, "-trailing" },
{ PACKS, &dict[114].count, 5, "pack$" },
{ DIGIT, &dict[115].count, 5, "digit" },
{ UDIVMOD, &dict[116].count, 5, "u/mod" },
{ EXTRACT, &dict[117].count, 7, "extract" },
{ BDIGS, &dict[118].count, 2, "<#" },
{ HOLD, &dict[119].count, 4, "hold" },
{ DIG, &dict[120].count, 1, "#" },
{ DIGS, &dict[121].count, 2, "#s" },
{ SIGN, &dict[122].count, 4, "sign" },
{ EDIGS, &dict[123].count, 2, "#>" },
{ STR, &dict[124].count, 3, "str" },
{ HEX, &dict[125].count, 3, "hex" },
{ DECIMAL, &dict[126].count, 7, "decimal" },
{ DIGITQ, &dict[127].count, 6, "digit?" },
{ DDROP, &dict[128].count, 5, "2drop" },
{ NUMBERQ, &dict[129].count, 7, "number?" },
{ CR, &dict[130].count, 2, "cr" },
{ NUFQ, &dict[131].count, 4, "nuf?" },
{ PACE , &dict[132].count, 4, "pace" },
{ SPACE, &dict[133].count, 5, "space" },
{ SPACES, &dict[134].count, 6, "spaces" },
{ TYPES, &dict[135].count, 4, "type" },
{ DOSTR, &dict[136].count, 3+COMPO, "do$" },
{ STRQP, &dict[137].count, 3+COMPO, "$\"|" },
{ DOTQP, &dict[138].count, 3+COMPO, ".\"|" },
{ DOTR, &dict[139].count, 2, ".r" },
{ UDOTR, &dict[140].count, 3, "u.r" },
{ UDOT, &dict[141].count, 2, "u." },
{ UTYPE, &dict[142].count, 5, "_type" },
{ DOT, &dict[143].count, 1, "." },
{ QUEST, &dict[144].count, 1, "?" },
{ PARS , &dict[145].count, 7, "(parse)" },
{ PARSE, &dict[146].count, 5, "parse" },
{ DOTPR, &dict[147].count, 2+IMEDD, ".(" },
{ PAREN, &dict[148].count, 1+IMEDD, "(" },
{ BKSLA, &dict[149].count, 1+IMEDD, "\\" },
{ CHAR , &dict[150].count, 4, "char" },
{ TOKEN , &dict[151].count, 5, "token" },
{ WORDD, &dict[152].count, 4, "word" },
{ NAMET, &dict[153].count, 5, "name>" },
{ BKSP, &dict[154].count, 2, "^h" },
{ TAP, &dict[155].count, 3, "tap" },
{ KTAP, &dict[156].count, 4, "ktap" },
{ ACCEPT, &dict[157].count, 6, "accept" },
{ EXPECT, &dict[158].count, 6, "expect" },
{ QUERY, &dict[159].count, 5, "query" },
{ CATCH , &dict[160].count, 5, "catch" },
{ THROW, &dict[161].count, 5, "throw" },
{ DOVAR, &dict[162].count, 5+COMPO, "dovar" },
{ DOVRAM, &dict[163].count, 6+COMPO, "dovram" },
{ NULLS, &dict[164].count, 5, "null$" },
{ ABORT, &dict[165].count, 5, "abort" },
{ ABORQ, &dict[166].count, 8+COMPO, "(abort\")" },
{ INTERP, &dict[167].count, 10, "$interpret" },
{ LBRAC, &dict[168].count, 1+IMEDD, "[" },
{ DOTOK, &dict[169].count, 3, ".ok" },
{ QSTACK, &dict[170].count, 6, "?stack" },
{ EVAL , &dict[171].count, 4, "eval" },
{ PRESET, &dict[172].count, 6, "preset" },
{ DSTORE, &dict[173].count, 2, "2!" },
{ DFETCH, &dict[174].count, 2, "2@" },
{ XIO, &dict[175].count, 3+COMPO, "xio" },
{ FILE, &dict[176].count, 4, "file" },
{ HAND, &dict[177].count, 4, "hand" },
{ ISLO , &dict[178].count, 3, "i/o" },
{ CONSOLE, &dict[179].count, 7, "console" },
{ QUIT, &dict[180].count, 4, "quit" },
{ DDUP, &dict[181].count, 4, "2dup" },
// The compiler
{ TICK, &dict[182].count, 1, "'" },
{ ALLOT, &dict[183].count, 5, "allot" },
{ COMMA, &dict[184].count, 1, "," },
{ BCOMP, &dict[185].count, 9+IMEDD, "[compile]" },
{ COMPILE, &dict[186].count, 7+COMPO, "compile" },
{ LITERAL, &dict[187].count, 7+IMEDD, "literal" },
{ STRCQ, &dict[188].count, 3, "$,\"" },
{ RECURSE, &dict[189].count, 7+IMEDD, "recurse" },
// Structures
{ FORR , &dict[190].count, 3+IMEDD, "for" },
{ BEGIN, &dict[191].count, 5+IMEDD, "begin" },
{ NEXT, &dict[192].count, 4+IMEDD, "next " },
{ UNTIL, &dict[193].count, 5+IMEDD, "until" },
{ AGAIN, &dict[194].count, 5+IMEDD, "again" },
{ IFF, &dict[195].count, 2+IMEDD, "if" },
{ AHEAD, &dict[196].count, 5+IMEDD, "ahead" },
{ REPEAT, &dict[197].count, 6+IMEDD, "repeat" },
{ THENN, &dict[198].count, 4+IMEDD, "then" },
{ AFT, &dict[199].count, 3+IMEDD, "aft" },
{ ELSEE, &dict[200].count, 4+IMEDD, "else" },
{ WHILE, &dict[201].count, 5+IMEDD, "while" },
{ ABORTQ, &dict[202].count, 6+IMEDD, "abort\"" },
{ STRQ, &dict[203].count, 2+IMEDD, "$\"" },
{ DOTQ , &dict[204].count, 2+IMEDD, ".\"" },
// Name Compiler
{ UNIQUE, &dict[205].count, 7, "?unique" },
{ SNAME, &dict[206].count, 3, "$,n" },
// Forth Compiler
{ SCOMP, &dict[207].count, 8, "$compile" },
{ OVERT, &dict[208].count, 5, "overt" },
{ SEMIS, &dict[209].count, 1+IMEDD+COMPO, ";" },
{ RBRAC, &dict[210].count, 1, "]" },
{ COLON, &dict[211].count, 1, ":" },
{ IMMEDIATE, &dict[212].count, 9+IMEDD, "immediate" },
{ COMPON, &dict[213].count, 9, "comp-only" },
// Defining words
{ HEADER, &dict[214].count, 6, "header" },
{ USER , &dict[215].count, 4, "user" },
{ CREATE, &dict[216].count, 6, "create" },
{ VARIABLE, &dict[217].count, 8, "variable" },
{ CONSTANT, &dict[218].count, 8, "constant", },
// Tools
{ DUMPP, &dict[219].count, 3, "dm+" },
{ DUMP, &dict[220].count, 4, "dump" },
{ DOTS , &dict[221].count, 2, ".s" },
{ STCSP, &dict[222].count, 4, "!csp" },
{ QCSP, &dict[223].count, 4, "?csp" },
{ TNAME, &dict[224].count, 5, ">name" },
{ DOTID, &dict[225].count, 3, ".id" },
{ SEE, &dict[226].count, 3, "see" },
{ WORDS, &dict[227].count, 5, "words" },
{ UP, &dict[228].count, 2, "up" },
{ DOUSER, &dict[229].count, 6+COMPO, "douser" },
{ VERSION, &dict[230].count, 7, "version" },
{ TBOOT, &dict[231].count, 5, "'boot" },
{ HI, &dict[232].count, 2, "hi'" },
{ CONTEXT, &dict[233].count, 7, "context" },
{ FORTH, &dict[234].count, 5, "forth" },
{ COLD, &dict[235].count, 4, "cold" }
}; // end of cfa[]
// ----------------------- Initialization ------------------------------------
// Initialize system & user variable space
j = 7; // start of variable space
for(i=0;i<sizeof(sys_var)-1;++i,++j)
mem[j] = sys_var[i];
texpect = (ACCEPT);
ttap = (KTAP);
tprompt = (DOTOK);
teval = (INTERP);
tnumber = (NUMBERQ);
// Allocate space for stacks. Both stacks grow downward.
RP = R0 = (INT) &mem[MEMSIZE]; // Highest
SP = S0 = (INT) &mem[MEMSIZE - RETURN_STACK]; // Just below it
// Name pointer to top of ram.
np = &mem[MEMSIZE - (RETURN_STACK + PAR_STACK)];
// Code pointer above pad
cp = &pad_end;
// User pointer area
up = &user;
// Variable pointer area
vp = &vm;
// point to last name in dictionary
vfrth = llast = &dict[(sizeof(dict) / sizeof(HEADS) - 1 )].count;
// Iniatialize character IO
initIO();
// Set IP to initial value
IP = (INT)_COLD;
// Fall through to next & go for it!
//------------------------------ primitive word codes -----------------------
// ---------------------------------- compiling ------------------------------
next:
// The address interpreter of Forth (ITC)
// Load W with what's inside the Code Field
// Advance IP
// Goto the label whose address now in W
W = *(PTR)IP;
INC(IP);
goto **(PTR)W; // W is not incremented here, which means we must do it
// in docol, docon and dodoes ... but is faster overall since
// next is faster.
docol:
// run time of colon
DEC(RP); // make room on return stack
TOR = IP; // save IP .. restored by semi
IP = W + CELL; // new IP
goto next;
semi:
// end of colon definition (exit)
IP = TOR;
INC(RP);
goto next;
dolit:
// plit ( -- n)
// Make room for the value
DEC(SP);
TOS = *(PTR)IP;
// Skip by the value
INC(IP);
goto next;
docon:
// ( -- n ) docon, run time of constant
DEC(SP); // make room
TOS = (*(PTR)(W + CELL)); // get contents of parameter field = W+CELL
goto next;
docase:
// ( switch n -- switch | empty ) docase, run time action of case
if(TOS==NOS) // n = switch?
{
INC(SP); // yes, pop stack
INC(IP); // all done, skip branch offset
goto next;
}
IP= *(PTR)IP; // next case
goto next;
execute:
// (ca -- ) execute cfa on stack.
W = TOS;
INC(SP); // pop stack
goto **(PTR)W; // jump to code
atexec:
// (a -- ) execute @ contents of address on stack.
W = TOS;
INC(SP); // pop stack
adr = (PTR)(DONEXT); // End of primitives
adr2 = *(PTR)W;
// Add extra level of indirection for COLON words
if( (PTR)adr2 >= (PTR)adr) W = *(PTR)W;
goto **(PTR)W;
// ----------------------------- branching -----------------------------------
branch:
IP = *(PTR)IP;
goto next;
zbranch:
// ( addr n -- )
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -