Wordlist of Camelforth for MAIS =============================== The following compilation of forth definitions is derived from the Camelforth glossary and augmented with the MAIS additions. This wordlist corresponds with MAIS CamelForth version 1.2 12-1-2004 Frans van der Markt Guide to stack diagrams: R: = return stack effect, L: = leave stack effect, used in do-loop, | = or in stack effect, alternative stack diagram c = 8-bit character, flag = boolean (0 or -1), n = signed 16-bit, u = unsigned 16-bit, d = signed 32-bit, ud = unsigned 32-bit, +n = unsigned 15-bit, x = any cell value, i*x j*x = any number of cell values, a-adr = aligned address, c-adr = character address, p-adr = I/O port address, sys = system-specific. Refer to ANS Forth document for more details. Wordsets: [A] Ansi core wordset [C] Only in Camelforth [E] Ansi extensions wordset [M] Extensions in MAIS Camelforth NAME Stack In -- Out Description Wordset ------------------------------------------------------------------------------------------- ! x a-adr -- store cell in memory [A] !CF adrs cfa -- set code action of a word [C] !COLON -- change code field to docolon [C] !DEST dest adrs -- change a branch destination [C] # ud1 -- ud2 convert 1 digit of output [A] #> ud1 -- c-adr u end conversion, get string [A] #INIT -- n #bytes of user area init data [C] #S ud1 -- ud2 convert remaining digits [A] ' -- xt find execution address of word [A] 'SOURCE -- a-adr two cells: length, adress [C] ( -- comment, skip input until ) [A] (+LOOP) n -- R: sys1 sys2 -- | sys1 sys2 run-time code for +LOOP [C] (DO) n1|u1 n2|u2 -- run-time code for DO [C] R: -- sys1 sys2 (DOES>) -- run-time action of DOES> [C] (LOOP) -- R: sys1 sys2 -- | sys1 sys2 run-time code for LOOP [C] (S") -- c-adr u run-time code for S" [C] * n1 n2 -- n3 signed multiply [A] */ n1 n2 n3 -- n4 n4 = n1*n2/n3 [A] */MOD n1 n2 n3 -- n4 n5 n5=n1*n2/n3, n4=remainder [A] + n1 n2 -- n3 add n1+n2, works also for unsigned [A] +! n/u a-adr -- add cell to contents of memory [A] +LOOP n -- add n to current loopindex and repeat the loop started with DO [A] , x -- append cell to dict [A] ,BRANCH xt -- append a branch instruction [C] ,CF adrs -- append a code field [C] ,DEST dest -- append a branch address [C] ,EXIT -- append hi-level EXIT action [C] - n1 n2 -- n3 n3 = n1-n2, also for unsigned [A] . n -- print the number n [A] ." -- print string terminated with " only within definition [A] .H n -- print hex digit corresponding with the value of n ( 0 <= n < 15) [C] .HH n -- print hex byte n [C] .HHHH a-adr -- print address hexadecimal [C] .S -- print stack contents [E] / n1 n2 -- n3 signed divide [A] /MOD n1 n2 -- n3 n4 signed divide, rem & quot [A] /STRING a u n -- a+n u-n trim string [E] 0< n -- flag true if TOS negative [A] 0<> n -- flag true if n <> 0 [M] 0= n/u -- flag return true if TOS=0 [A] 1+ n1/u1 -- n2/u2 add 1 to TOS [A] 1- n1/u1 -- n2/u2 subtract 1 from TOS [A] 2! x1 x2 a-adr -- store 2 cells [A] 2* x1 -- x2 multiply by 2 (left shift) [A] 2/ x1 -- x2 divide by 2 (right shift) [A] 2@ a-adr -- x1 x2 fetch 2 cells [A] 2DROP x1 x2 -- drop 2 cells [A] 2DUP x1 x2 -- x1 x2 x1 x2 dup top 2 cells [A] 2OVER x1 x2 x3 x4 -- x1 x2 x3 x4 x1 x2 per diagram [A] 2SWAP x1 x2 x3 x4 -- x3 x4 x1 x2 per diagram [A] : -- begin a colon definition [A] ; -- end a colon definition [A] < n1 n2 -- flag test n1 x1 x2 -- flag test not equal [A] = x1 x2 -- flag test x1=x2 [A] > n1 n2 -- flag test n1>n2, signed [A] >< x1 -- x2 swap bytes [C] >BODY xt -- a-adr address of param field [A] >COUNTED src n dst -- copy to counted str [C] >DIGIT n -- c convert to 0..9A..Z [C] >IN -- a-adr holds offset into TIB [A] >L x -- move to Leave stack [C] L: -- x >NUMBER ud adr u -- ud' adr' u' convert string to number [A] >R x -- push to return stack [A] R: -- x ? a-adr -- print cell at address [M] ?ABORT flag c-adr u -- abort if flag and print msg [C] ?BRANCH x -- branch if TOS zero [C] ?DNEGATE d1 n -- d2 negate d1 if n is negative [C] ?DUP x -- 0 | x x DUP if x is nonzero [A] ?NEGATE n1 n2 -- n3 negate n1 if n2 negative [C] ?NUMBER c-adr -- n -1 convert string->number c-adr -- c-adr 0 if convert error [C] ?PFNUM c-adr -- n -1 checks presence of prefix and then c-adr -- c-adr 0 calls ?NUMBER [M] #xxx to force a decimal number $xxx to force a hexadecimal number %xxx to force a binary number &a the ascii code of 'a' (&B = 66) ^a the control code of 'a' (^B = 02) ?SIGN adr n -- adr' n' f get optional sign advance adr/n if sign; return NZ if negative [C] @ a-adr -- x fetch cell from memory [A] ABORT i*x -- R: j*x -- clear stack & QUIT [A] ABORT" i*x 0 -- i*x R: j*x -- j*x print msg & abort if x1 <> 0 [A] i*x x1 -- R: j*x -- ABS n1 -- |n1| absolute value [A] ACCEPT c-adr +n -- +n' get line from terminal [A] AGAIN -- unconditional backward branch [E] used in BEGIN .... AGAIN ALIGN -- make HERE aligned on cellboundary [A] ALIGNED adr -- a-adr align given addr [A] ALLOT n -- allocate n bytes in dictionary [A] AND x1 x2 -- x3 binary AND [A] BASE -- a-adr uservar, holds conversion radix [A] BEGIN -- target for backward branch [A] BL -- char an ASCII space [A] BRANCH -- branch always (primitive) [A] C! c c-adr -- store char in memory [A] C, char -- append char to dict [A] C@ c-adr -- c fetch char from memory [A] CELL -- n leave address units per CELL [C] CELL+ a-adr1 -- a-adr2 add cell size to adrs [A] CELLS n1 -- n2 cells->adrs units [A] CHAR -- char parse ASCII character [A] CHARS n1 -- n2 chars->adrs units [A] CHAR+ c-adr1 -- c-adr2 add char size to adrs [A] CMOVE c-adr1 c-adr2 u -- move u chars from bottom [E] CMOVE> c-adr1 c-adr2 u -- move u chars from top [E] COLD -- cold start Forth system [C] COMPILE, xt -- append execution token [E] CONSTANT n -- define a Forth constant [A] COUNT c-adr1 -- c-adr2 u counted string ->adr/len [A] CR -- output newline [A] CREATE -- create an empty definition [A] CVNUM c_adr base -- n -1 | c-addr 0 used for number conversion [M] DABS d1 -- +d2 absolute value, dbl.prec. [E] DECIMAL -- set number base to decimal [A] DEPTH -- +n number of items on stack [A] DIGIT? c -- n -1 ..if c is a valid digit -- x 0 ..otherwise [C] DNEGATE d1 -- d2 negate, double precision [A] DO -- start of DO..LOOP L: -- 0 used as: end+1 start DO ... LOOP [A] DOES> -- change action of latest definition [A] DP -- a-addr uservar that holds dictionary ptr [A] DROP x -- drop top of stack [A] DUMP adr n -- dump n bytes of memory from adr [C] DUMPA adr -- dump 16 bytes as ascii from adr [C] DUMPH adr -- dump 16 bytes as hex from adr [C] DUP x -- x x duplicate the top of stack [A] ELSE -- branch for IF..ELSE used in: flag IF ... ELSE ... THEN [A] EMIT char -- output a character [A] EMIT? -- flag test if outputchannel ready [M] ENDLOOP adr xt -- used in DO..LOOP [C] L: 0 a1 a2 .. aN -- ENVIRONMENT? c-adr u -- false system query [A] EVALUATE i*x c-adr u -- j*x interpret string [A] EXECUTE i*x xt -- j*x execute Forth word 'xt' [A] EXIT -- exit a colon definition [A] FALSE -- 0 leave false flag on stack [M] FILL c-adr u c -- fill memory with char [A] FIND c-adr -- c-addr 0 ..if name not found c-adr -- xt 1 ..if immediate c-adr -- xt -1 ..if "normal" [A] FM/MOD d1 n1 -- n2 n3 floored mixed signed division n2 is rem, n3 is quotient [A] HERE -- adr returns dictionary pointer [A] HEX -- set number base to hex [E] HIDE -- "hide" latest definition [C] HOLD char -- add char to output string during number output <# #> [A] HP -- a-addr HOLD pointer [C] I -- n R: sys1 sys2 -- sys1 sys2 get the innermost loop index [A] IF flag -- conditional forward branch [A] IMMED? nfa -- f fetch immediate flag [C] IMMEDIATE -- make last definition immediate [A] INTERPRET i*x c-adr u -- j*x interpret given buffer [A] INVERT x1 -- x2 bitwise inversion see also NOT [A] IVEC -- adr uservariable giving the address of the first of six interrupt vectors: IVEC 0 + @ is SWI3 address IVEC 2 + @ is SWI2 address IVEC 4 + @ is FIRQ address IVEC 6 + @ is IRQ address IVEC 8 + @ is SWI address IVEC 10 + @ is NMI address [M] J -- n R: 4*sys -- 4*sys get the second loop index [A] KEY -- char accept a character from input and place it on the stack [A] KEY? -- flag return true if char waiting [A] L0 -- a-adr bottom of Leave stack [C] L> -- x move from Leave stack [C] L: x -- LATEST -- a-adr last word in dictionary [A] LEAVE -- exit DO..LOOP [A] L: -- adrs LIT -- x fetch inline literal to stack [C] LITERAL x -- append numeric literal to dict. [A] LOOP -- end of DO..LOOP [A] L: 0 a1 a2 .. aN -- jump back to after corresp. DO DO, incrementing the loopcounter [A] LP -- a-addr Leave-stack pointer [C] LSHIFT x1 u -- x2 logical L shift u places [A] M* n1 n2 -- d signed 16*16->32 multiply [A] M+ d1 n -- d2 add single to double [E] MAX n1 n2 -- n3 signed maximum [A] MEM? c-adr -- f lag leaves true if c-adr is ram [M] MEMORY -- measures and prints available ram [M] MIN n1 n2 -- n3 signed minimum [A] MOD n1 n2 -- n3 signed remainder [A] MOVE adr1 adr2 u -- smart move of u bytes from adr1 to adr2 [A] NEGATE x1 -- x2 two's complement [A] NFA>CFA nfa -- cfa name adr -> code field [C] NFA>LFA nfa -- lfa name adr -> link field [C] NIP x1 x2 -- x2 per stack diagram [E] NOT flag1 -- flag2 flag2 is the opposite of flag1 this is a logical inversion [M] OR x1 x2 -- x3 binary OR [A] OVER x1 x2 -- x1 x2 x1 per stack diagram [A] PAD -- a-addr user PAD buffer [E] POSTPONE -- postpone compile action of next word in the inputstream [A] QUIT -- R: i*x -- scan and interpret inputstream this is the basic forth machine [A] R0 -- a-addr bottom of the return stack [C] R> -- x R: x -- pop cell from return stack [A] R@ -- x copy one cell from return stack [A] R: x -- x RECURSE -- recurse the current definition [A] REPEAT -- resolve WHILE loop BEGIN ... WHILE ... REPEAT [A] REVEAL -- "reveal" latest definition see also HIDE [C] ROT x1 x2 x3 -- x2 x3 x1 per stack diagram [A] RP! a-adr -- set returnstack pointer to address [C] RP@ -- a-addr get return stack pointer [C] RSHIFT x1 u -- x2 logical right shift over u bits [A] S" -- compile in-line string terminated by " [A] S0 -- a-addr bottom of parameter stack [C] S= c-adr1 c-adr2 u -- n string compare n<0: s10: s1>s2 [C] S>D n -- d single -> double precision [A] SCAN c-adr1 u1 c -- c-adr2 u2 find matching char c in string [C] SEMIT c -- print character c if its code is larger than SPACE else '.' used in dump [M] SIGN n -- add minus sign if n<0, used in output of numbers [A] SKIP c-adr1 u1 c -- c-adr2 u2 skip matching chars c [C] SM/REM d1 n1 -- n2 n3 symmetric signed division [A] SOURCE -- adr n address and length of the current input buffer [A] SP! a-adr -- set data stack pointer [C] SP@ -- a-addr get data stack pointer [C] SPACE -- output a space [A] SPACES n -- output n spaces [A] STATE -- a-addr user var that holds compiler state [A] SWAP x1 x2 -- x2 x1 swap top two items [A] THEN -- resolve forward branch used in: flag IF ... THEN [A] TIB -- a-addr Terminal Input Buffer [A] TIBSIZE -- n size of Terminal Input Buffer [C] TRUE -- flag true flag [M] TUCK x1 x2 -- x2 x1 x2 per stack diagram [E] TYPE c-adr +n -- type line to terminal [A] U. u -- display u unsigned [A] U0 -- a-addr current user area adrs [C] U< u1 u2 -- flag test u1 u1 u2 -- flag test u1>u2, unsigned [E] UD* ud1 u2 -- ud3 32*16->32 multiply [C] UD/MOD ud1 u2 -- u3 ud4 32/16->32 divide [C] UINIT -- addr initial values for user area [C] UM* u1 u2 -- ud unsigned 16x16->32 mult. [A] UM/MOD ud u1 -- u2 u3 unsigned 32/16->16 div. u2 is remainder, u3 is quotient [A] UMAX u1 u2 -- u unsigned maximum [C] UMIN u1 u2 -- u unsigned minimum [C] UNLOOP -- drop loop parms, used for R: sys1 sys2 -- premature exit of DO..LOOP [A] UNTIL flag -- conditional backward branch used in: BEGIN ... flag UNTIL [A] USER x -- create a user variable with offset 2x from the start of the user area. Note: some uservariables are used internally in Camelforth. [C] VARIABLE -- : name create a new variable with name given in the inputstream eg: VARIABLE counter 0 counter ! counter @ [A] WHILE flag -- branch for WHILE loop used in: BEGIN..flag WHILE..REPEAT [A] WITHIN n1|u1 n2|u2 n3|u3 -- flag test n2<=n1