PWR_STATE
-[UNDEFINED] {SD_TEST} [IF] \
+[DEFINED] {SD_TEST} [IF] {SD_TEST} [THEN] \ remove it if defined out of kernel
+
+[UNDEFINED] MARKER [IF]
+\ https://forth-standard.org/standard/core/MARKER
+\ MARKER
+\ ( "<spaces>name" -- )
+\ Skip leading space delimiters. Parse name delimited by a space. Create a definition for name
+\ with the execution semantics defined below.
+\
+\ name Execution: ( -- )
+\ Restore all dictionary allocation and search order pointers to the state they had just prior to the
+\ definition of name. Remove the definition of name and all subsequent definitions. Restoration
+\ of any structures still existing that could refer to deleted definitions or deallocated data space is
+\ not necessarily provided. No other contextual information such as numeric base is affected
+\
+: MARKER
+CREATE
+HI2LO
+MOV &LASTVOC,0(W) \ [BODY] = LASTVOC
+SUB #2,Y \ 1 Y = LFA
+MOV Y,2(W) \ 3 [BODY+2] = LFA = DP to be restored
+ADD #4,&DP \ 3 add 2 cells
+LO2HI
+DOES>
+HI2LO
+MOV @RSP+,IP \ -- PFA
+MOV @TOS+,&INIVOC \ set VOC_LINK value for RST_STATE
+MOV @TOS,&INIDP \ set DP value for RST_STATE
+MOV @PSP+,TOS \ --
+MOV #RST_STATE,PC \ execute RST_STATE, PWR_STATE then STATE_DOES
+ENDCODE
+[THEN]
MARKER {SD_TEST}
+[UNDEFINED] EXIT [IF]
+\ https://forth-standard.org/standard/core/EXIT
+\ EXIT -- exit a colon definition; CALL #EXIT performs ASMtoFORTH (10 cycles)
+\ JMP #EXIT performs EXIT
+CODE EXIT
+MOV @RSP+,IP \ 2 pop previous IP (or next PC) from return stack
+MOV @IP+,PC \ 4 = NEXT
+ \ 6 (ITC-2)
+ENDCODE
+[THEN]
+
+[UNDEFINED] SWAP [IF]
+\ https://forth-standard.org/standard/core/SWAP
+\ SWAP x1 x2 -- x2 x1 swap top two items
+CODE SWAP
+MOV @PSP,W \ 2
+MOV TOS,0(PSP) \ 3
+MOV W,TOS \ 1
+MOV @IP+,PC \ 4
+ENDCODE
+[THEN]
+
+[UNDEFINED] >BODY [IF]
+\ https://forth-standard.org/standard/core/toBODY
+\ >BODY -- addr leave BODY of a CREATEd word\ also leave default ACTION-OF primary DEFERred word
+CODE >BODY
+ADD #4,TOS
+MOV @IP+,PC
+ENDCODE
+[THEN]
+
+[UNDEFINED] 0= [IF]
+\ https://forth-standard.org/standard/core/ZeroEqual
+\ 0= n/u -- flag return true if TOS=0
+CODE 0=
+SUB #1,TOS \ borrow (clear cy) if TOS was 0
+SUBC TOS,TOS \ TOS=-1 if borrow was set
+MOV @IP+,PC
+ENDCODE
+[THEN]
+
+[UNDEFINED] IF [IF]
+\ https://forth-standard.org/standard/core/IF
+\ IF -- IFadr initialize conditional forward branch
+CODE IF \ immediate
+SUB #2,PSP \
+MOV TOS,0(PSP) \
+MOV &DP,TOS \ -- HERE
+ADD #4,&DP \ compile one word, reserve one word
+MOV #QFBRAN,0(TOS) \ -- HERE compile QFBRAN
+ADD #2,TOS \ -- HERE+2=IFadr
+MOV @IP+,PC
+ENDCODE IMMEDIATE
+[THEN]
+
+[UNDEFINED] THEN [IF]
+\ https://forth-standard.org/standard/core/THEN
+\ THEN IFadr -- resolve forward branch
+CODE THEN \ immediate
+MOV &DP,0(TOS) \ -- IFadr
+MOV @PSP+,TOS \ --
+MOV @IP+,PC
+ENDCODE IMMEDIATE
+[THEN]
+
+[UNDEFINED] ELSE [IF]
+\ https://forth-standard.org/standard/core/ELSE
+\ ELSE IFadr -- ELSEadr resolve forward IF branch, leave ELSEadr on stack
+CODE ELSE \ immediate
+ADD #4,&DP \ make room to compile two words
+MOV &DP,W \ W=HERE+4
+MOV #BRAN,-4(W)
+MOV W,0(TOS) \ HERE+4 ==> [IFadr]
+SUB #2,W \ HERE+2
+MOV W,TOS \ -- ELSEadr
+MOV @IP+,PC
+ENDCODE IMMEDIATE
+[THEN]
+
+[UNDEFINED] UNTIL [IF]
+\ https://forth-standard.org/standard/core/UNTIL
+\ UNTIL BEGINadr -- resolve conditional backward branch
+CODE UNTIL \ immediate
+ MOV #QFBRAN,X
+BW1 ADD #4,&DP \ compile two words
+ MOV &DP,W \ W = HERE
+ MOV X,-4(W) \ compile Bran or QFBRAN at HERE
+ MOV TOS,-2(W) \ compile bakcward adr at HERE+2
+ MOV @PSP+,TOS
+ MOV @IP+,PC
+ENDCODE IMMEDIATE
+[THEN]
+
+[UNDEFINED] WHILE [IF]
+\ https://forth-standard.org/standard/core/WHILE
+\ WHILE BEGINadr -- WHILEadr BEGINadr
+: WHILE \ immediate
+POSTPONE IF SWAP
+; IMMEDIATE
+[THEN]
+
+[UNDEFINED] AGAIN [IF]
+\ https://forth-standard.org/standard/core/AGAIN
+\ AGAIN BEGINadr -- resolve uncondionnal backward branch
+CODE AGAIN \ immediate
+MOV #BRAN,X
+GOTO BW1
+ENDCODE IMMEDIATE
+[THEN]
+
+[UNDEFINED] REPEAT [IF]
+\ https://forth-standard.org/standard/core/REPEAT
+\ REPEAT WHILEadr BEGINadr -- resolve WHILE loop
+: REPEAT
+POSTPONE AGAIN POSTPONE THEN
+; IMMEDIATE
+[THEN]
+
+[UNDEFINED] DO [IF]
+\ https://forth-standard.org/standard/core/DO
+\ DO -- DOadr L: -- 0
+CODE DO \ immediate
+SUB #2,PSP \
+MOV TOS,0(PSP) \
+ADD #2,&DP \ make room to compile xdo
+MOV &DP,TOS \ -- HERE+2
+MOV #XDO,-2(TOS) \ compile xdo
+ADD #2,&LEAVEPTR \ -- HERE+2 LEAVEPTR+2
+MOV &LEAVEPTR,W \
+MOV #0,0(W) \ -- HERE+2 L-- 0
+MOV @IP+,PC
+ENDCODE IMMEDIATE
+[THEN]
+
+[UNDEFINED] LOOP [IF]
+\ https://forth-standard.org/standard/core/LOOP
+\ LOOP DOadr -- L-- an an-1 .. a1 0
+CODE LOOP \ immediate
+ MOV #XLOOP,X
+BW1 ADD #4,&DP \ make room to compile two words
+ MOV &DP,W
+ MOV X,-4(W) \ xloop --> HERE
+ MOV TOS,-2(W) \ DOadr --> HERE+2
+BEGIN \ resolve all "leave" adr
+ MOV &LEAVEPTR,TOS \ -- Adr of top LeaveStack cell
+ SUB #2,&LEAVEPTR \ --
+ MOV @TOS,TOS \ -- first LeaveStack value
+ CMP #0,TOS \ -- = value left by DO ?
+0<> WHILE
+ MOV W,0(TOS) \ move adr after loop as UNLOOP adr
+REPEAT
+ MOV @PSP+,TOS
+ MOV @IP+,PC
+ENDCODE IMMEDIATE
+[THEN]
+
+[UNDEFINED] +LOOP [IF]
+\ https://forth-standard.org/standard/core/PlusLOOP
+\ +LOOP adrs -- L-- an an-1 .. a1 0
+CODE +LOOP \ immediate
+MOV #XPLOOP,X
+GOTO BW1
+ENDCODE IMMEDIATE
+[THEN]
+
+[UNDEFINED] I [IF]
+\ https://forth-standard.org/standard/core/I
+\ I -- n R: sys1 sys2 -- sys1 sys2
+\ get the innermost loop index
+CODE I
+SUB #2,PSP \ 1 make room in TOS
+MOV TOS,0(PSP) \ 3
+MOV @RSP,TOS \ 2 index = loopctr - fudge
+SUB 2(RSP),TOS \ 3
+MOV @IP+,PC \ 4 13~
+ENDCODE
+[THEN]
+
[UNDEFINED] + [IF]
\ https://forth-standard.org/standard/core/Plus
\ + n1/u1 n2/u2 -- n3/u3 add n1+n2
ENDCODE
[THEN]
+[UNDEFINED] - [IF]
+\ https://forth-standard.org/standard/core/Minus
+\ - n1/u1 n2/u2 -- n3/u3 n3 = n1-n2
+CODE -
+SUB @PSP+,TOS \ 2 -- n2-n1 ( = -n3)
+XOR #-1,TOS \ 1
+ADD #1,TOS \ 1 -- n3 = -(n2-n1) = n1-n2
+MOV @IP+,PC
+ENDCODE
+[THEN]
+
[UNDEFINED] MAX [IF] \ MAX and MIN are defined in {ANS_COMP}
CODE MAX \ n1 n2 -- n3 signed maximum
CMP @PSP,TOS \ n2-n1
ENDCODE
[THEN]
+[UNDEFINED] @ [IF]
+\ https://forth-standard.org/standard/core/Fetch
+\ @ c-addr -- char fetch char from memory
+CODE @
+MOV @TOS,TOS
+MOV @IP+,PC
+ENDCODE
+[THEN]
+
[UNDEFINED] C@ [IF]
\ https://forth-standard.org/standard/core/CFetch
\ C@ c-addr -- char fetch char from memory
ENDCODE
[THEN]
+[UNDEFINED] ! [IF]
+\ https://forth-standard.org/standard/core/Store
+\ ! x a-addr -- store cell in memory
+CODE !
+MOV @PSP+,0(TOS) \ 4
+MOV @PSP+,TOS \ 2
+MOV @IP+,PC \ 4
+ENDCODE
+[THEN]
+
[UNDEFINED] SPACE [IF]
\ https://forth-standard.org/standard/core/SPACE
\ SPACE -- output a space
ENDCODE
[THEN]
+[UNDEFINED] DUP [IF]
+\ https://forth-standard.org/standard/core/DUP
+\ DUP x -- x x duplicate top of stack
+CODE DUP
+BW1 SUB #2,PSP \ 2 push old TOS..
+ MOV TOS,0(PSP) \ 3 ..onto stack
+ MOV @IP+,PC \ 4
+ENDCODE
+
+\ https://forth-standard.org/standard/core/qDUP
+\ ?DUP x -- 0 | x x DUP if nonzero
+CODE ?DUP
+CMP #0,TOS \ 2 test for TOS nonzero
+0<> ?GOTO BW1 \ 2
+MOV @IP+,PC \ 4
+ENDCODE
+[THEN]
+
[UNDEFINED] OVER [IF]
\ https://forth-standard.org/standard/core/OVER
\ OVER x1 x2 -- x1 x2 x1
ENDCODE
[THEN]
+[UNDEFINED] >R [IF]
+\ https://forth-standard.org/standard/core/toR
+\ >R x -- R: -- x push to return stack
+CODE >R
+PUSH TOS
+MOV @PSP+,TOS
+MOV @IP+,PC
+ENDCODE
+[THEN]
+
+[UNDEFINED] R> [IF]
+\ https://forth-standard.org/standard/core/Rfrom
+\ R> -- x R: x -- pop from return stack ; CALL #RFROM performs DOVAR
+CODE R>
+SUB #2,PSP \ 1
+MOV TOS,0(PSP) \ 3
+MOV @RSP+,TOS \ 2
+MOV @IP+,PC \ 4
+ENDCODE
+[THEN]
+
+[UNDEFINED] CONSTANT [IF]
+\ https://forth-standard.org/standard/core/CONSTANT
+\ CONSTANT <name> n -- define a Forth CONSTANT
+: CONSTANT
+CREATE
+HI2LO
+MOV TOS,-2(W) \ PFA = n
+MOV @PSP+,TOS
+MOV @RSP+,IP
+MOV @IP+,PC
+ENDCODE
+[THEN]
+
+[UNDEFINED] STATE [IF]
+\ https://forth-standard.org/standard/core/STATE
+\ STATE -- a-addr holds compiler state
+STATEADR CONSTANT STATE
+[THEN]
+
+[UNDEFINED] DEFER! [IF]
+\ https://forth-standard.org/standard/core/DEFERStore
+\ Set the word xt1 to execute xt2. An ambiguous condition exists if xt1 is not for a word defined by DEFER.
+CODE DEFER! \ xt2 xt1 --
+MOV @PSP+,2(TOS) \ -- xt1=CFA_DEFER xt2 --> [CFA_DEFER+2]
+MOV @PSP+,TOS \ --
+MOV @IP+,PC
+ENDCODE
+[THEN]
+
+[UNDEFINED] IS [IF]
+\ https://forth-standard.org/standard/core/IS
+\ IS <name> xt --
+\ used as is :
+\ DEFER DISPLAY create a "do nothing" definition (2 CELLS)
+\ inline command : ' U. IS DISPLAY U. becomes the runtime of the word DISPLAY
+\ or in a definition : ... ['] U. IS DISPLAY ...
+\ KEY, EMIT, CR, ACCEPT and WARM are examples of DEFERred words
+\
+\ as IS replaces the PFA value of any word, it's a TO alias for VARIABLE and CONSTANT words...
+: IS
+STATE @
+IF POSTPONE ['] POSTPONE DEFER!
+ELSE ' DEFER!
+THEN
+; IMMEDIATE
+[THEN]
+
[UNDEFINED] U.R [IF] \ defined in {UTILITY}
: U.R \ u n -- display u unsigned in n width (n >= 2)
>R <# 0 # #S #>
;
[THEN]
+[UNDEFINED] HERE [IF]
+CODE HERE
+MOV #BEGIN,PC
+ENDCODE
+[THEN]
+
\ SD_EMIT c -- output char c to a SD_CARD file opened as write
CODE SD_EMIT
CMP #512,&BufferPtr \ 512 bytes by sector
U>= IF \ if file buffer is full
- MOV #WRITE,X \ CALL WRITEFILE
+ MOV #WRITE,X \ CALL #Write_File
CALL 2(X) \ BufferPtr = 0
THEN
MOV &BufferPtr,Y \ 3
." 0 Set date and time" CR
." 1 Load {TOOLS} words" CR
." 2 Load {SD_TOOLS} words" CR
-." 3 Load {ANS_COMP} words" CR
+." 3 Load {CORE_COMP} words" CR
." 4 Load ANS core tests" CR
." 5 Load a 100k program " CR
." 6 Read only this source file" CR
LOAD" SD_TOOLS.4TH"
ELSE 1 - ?DUP
0= IF
- ." LOAD ANS_COMP.4TH" CR
- LOAD" ANS_COMP.4TH"
+ ." LOAD CORECOMP.4TH" CR
+ LOAD" CORECOMP.4TH"
ELSE 1 - ?DUP
0= IF
." LOAD CORETEST.4TH" CR
." WRITE YOURFILE.TXT" CR
WRITE" YOURFILE.TXT"
['] SD_EMIT IS EMIT
+\ ." va te faire voir"
MAIN_ORG HERE OVER - DUMP
['] EMIT >BODY IS EMIT
CLOSE
THEN
;
+
+
RST_HERE
[THEN]
OSDN Git Service
