X-Git-Url: http://git.osdn.net/view?a=blobdiff_plain;f=forthMSP430FR_CONDCOMP.asm;h=e7cb74dfa3a156fe6be8b73de69c7e658ac34fc0;hb=96177dd8ef89df6aa0173ba33c4d21b2fb8581e3;hp=4ac54a1893edda4ca62d021c0f3a1cf6b4cf1e61;hpb=30132d9a630e8488c5b7d2bded3b1feb562abbd3;p=fast-forth%2Fmaster.git diff --git a/forthMSP430FR_CONDCOMP.asm b/forthMSP430FR_CONDCOMP.asm index 4ac54a1..e7cb74d 100644 --- a/forthMSP430FR_CONDCOMP.asm +++ b/forthMSP430FR_CONDCOMP.asm @@ -1,51 +1,135 @@ +; -*- coding: utf-8 -*- +; + FORTHWORDIMM "[THEN]" ; do nothing +; https://forth-standard.org/standard/tools/BracketTHEN +; [THEN] + MOV @IP+,PC +; ; https://forth-standard.org/standard/string/COMPARE +; ; COMPARE ( c-addr1 u1 c-addr2 u2 -- n ) +; ;Compare the string specified by c-addr1 u1 to the string specified by c-addr2 u2. +; ;The strings are compared, beginning at the given addresses, character by character, +; ;up to the length of the shorter string or until a difference is found. +; ;If the two strings are identical, n is zero. +; ;If the two strings are identical up to the length of the shorter string, +; ; n is minus-one (-1) if u1 is less than u2 and one (1) otherwise. +; ;If the two strings are not identical up to the length of the shorter string, +; ; n is minus-one (-1) if the first non-matching character in the string specified by c-addr1 u1 +; ; has a lesser numeric value than the corresponding character in the string specified by c-addr2 u2 and one (1) otherwise. +; FORTHWORD "COMPARE" +; COMPARE +; MOV TOS,S ;1 S = u2 +; MOV @PSP+,Y ;2 Y = addr2 +; MOV @PSP+,T ;2 T = u1 +; MOV @PSP+,X ;2 X = addr1 +; COMPLOOP MOV T,TOS ;1 +; ADD S,TOS ;1 TOS = u1+u2 +; JZ COMPEQUAL ;2 u1=u2=0, Z=1, end of all successfull comparisons +; SUB #1,T ;1 +; JN COMPLESS ;2 u1u2 if u2 < 0 +; ADD #1,X ;1 +; CMP.B @Y+,-1(X) ;4 char1-char2 +; JZ COMPLOOP ;2 char1=char2 17~ loop +; JC COMPGREATER ;2 char1>char2 +; COMPLESS ; char1char2 -COMPLESS ; char1name ..." -- ) +; ;Skipping leading spaces, parse and discard space-delimited words from the parse area, +; ;including nested occurrences of [IF] ... [THEN] and [IF] ... [ELSE] ... [THEN], +; ;until the word [THEN] has been parsed and discarded. +; ;If the parse area becomes exhausted, it is refilled as with REFILL. +; FORTHWORDIMM "[ELSE]" ; or [IF] if isnogood... +; BRACKETELSE +; mDOCOL +; .word lit,0 ; -- cnt=0 +; BRACKETELSE0 +; .word ONEPLUS ; -- cnt+1 +; BRACKETELSE1 ; +; .word FBLANK,WORDD,COUNT ; -- cnt addr u +; .word DUP,QFBRAN,BRACKETELSE5 ; u = 0 if end of line --> refill buffer then loop back +; .word TWODUP ; +; .word XSQUOTE ; +; .byte 6,"[THEN]" ; +; .word COMPARE,ZEROEQUAL ; +; .word QFBRAN,BRACKETELSE2 ; -- cnt addr u if bad comparaison, jump for next comparaison +; .word TWODROP,ONEMINUS ; -- cnt-1 2DROP, decrement count +; .word QDUP,ZEROEQUAL ; +; .word QFBRAN,BRACKETELSE1 ; -- cnt-1 loop back if count <> 0 +; .word EXIT ; -- else exit +; BRACKETELSE2 ; +; .word TWODUP ; -- cnt addr u addr u +; .word XSQUOTE ; +; .byte 6,"[ELSE]" ; +; .word COMPARE,ZEROEQUAL ; -- cnt addr u ff +; .word QFBRAN,BRACKETELSE3 ; -- cnt addr u if bad comparaison, jump for next comparaison +; .word TWODROP,ONEMINUS ; -- cnt-1 2DROP, decrement count +; .word QDUP,ZEROEQUAL ; +; .word QFBRAN,BRACKETELSE0 ; -- cnt-1 if count <> 0 restore old count with loop back increment +; .word EXIT ; -- else exit +; BRACKETELSE3 ; +; .word XSQUOTE ; +; .byte 4,"[IF]" ; +; .word COMPARE,ZEROEQUAL ; +; .word QFBRAN,BRACKETELSE1 ; -- cnt if bad comparaison, loop back +; .word BRAN,BRACKETELSE0 ; -- cnt else increment loop back +; BRACKETELSE5 ; +; .word TWODROP ; -- cnt +; ;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^; +; ; OPTION ; plus 5 words option +; ;vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv; +; .word XSQUOTE ; +; .byte 5,13,10,"ko " ; +; .word TYPE ; CR+LF ." ko" to show false branch of conditionnal compilation +; ;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^; +; .word REFILL ; REFILL Input Buffer with next line +; .word SETIB ; SET Input Buffer pointers SOURCE_LEN, SOURCE_ORG and clear >IN +; .word BRAN,BRACKETELSE1 ; -- cnt then loop back 54 words without options + +; BRanch if string BAD COMParaison, [COMPARE,ZEROEQUAL,QFBRAN] replacement +BRBADCOMP ; -- cnt addr1 u1 addr1 u1 addr2 u2 + MOV TOS,S ;1 S = u2 + MOV @PSP+,Y ;2 Y = addr2 + MOV @PSP+,T ;2 T = u1 + MOV @PSP+,X ;2 X = addr1 +COMPLOOP MOV T,TOS ;1 -- cnt addr1 u1 u1 + ADD S,TOS ;1 -- cnt addr1 u1 u1+u2 + JZ COMPEQU ;2 u1=u2=0, Z=1, end of all successfull comparisons + SUB #1,T ;1 + JN COMPDIF ;2 u1u2 if u2 < 0 + ADD #1,X ;1 + CMP.B @Y+,-1(X) ;4 char1-char2 + JZ COMPLOOP ;2 char1=char2 17~ loop +COMPDIF MOV @IP,IP ;1 take branch +CMPEND MOV @PSP+,TOS ; + MOV @IP+,PC ;4 + +; BRanch if string GOOD COMParaison, [TWODROP,ONEMINUS,?DUP,ZEROEQUAL,QFBRAN] replacement +BRGOODCMP ; -- cnt addr u + ADD #2,PSP ;1 -- cnt u + SUB #1,0(PSP) ;3 -- cnt-1 u + JNZ COMPDIF ;2 -- cnt-1 u take branch + ADD #2,PSP ;1 -- u +COMPEQU ADD #2,IP ; skip branch + JMP CMPEND ; 25 words + + FORTHWORDIMM "[ELSE]" ; or [IF] if isnogood... +; https://forth-standard.org/standard/tools/BracketELSE +; [ELSE] a few (smaller and faster) definition ;Compilation: ;Perform the execution semantics given below. ;Execution: @@ -54,60 +138,48 @@ COMPEQUAL ;including nested occurrences of [IF] ... [THEN] and [IF] ... [ELSE] ... [THEN], ;until the word [THEN] has been parsed and discarded. ;If the parse area becomes exhausted, it is refilled as with REFILL. - FORTHWORDIMM "[ELSE]" BRACKETELSE - mDOCOL - .word lit,1 ; 1 -BRACKETELSE1 ; BEGIN -BRACKETELSE2 ; BEGIN - .word FBLANK,WORDD,COUNT ; BL WORD COUNT - .word DUP,QBRAN,BRACKETELSE10 ; DUP WHILE - .word OVER,OVER ; 2DUP - .word XSQUOTE ; S" [IF]" - .byte 4,"[IF]" ; - .word COMPARE ; COMPARE - .word QZBRAN,BRACKETELSE3 ; 0= IF - .word TWODROP,ONEPLUS ; 2DROP 1+ - .word BRAN,BRACKETELSE8 ; (ENDIF) -BRACKETELSE3 ; ELSE - .word OVER,OVER ; OVER OVER - .word XSQUOTE ; S" [ELSE]" - .byte 6,"[ELSE]" ; - .word COMPARE ; COMPARE - .word QZBRAN,BRACKETELSE5 ; 0= IF - .word TWODROP,ONEMINUS ; 2DROP 1- -; .word DUP,QBRAN,BRACKETELSE4 ; DUP IF - .word DUP,QBRAN,BRACKETELSE7 ; - .word ONEPLUS ; 1+ -BRACKETELSE4 ; THEN - .word BRAN,BRACKETELSE7 ; (ENDIF) -BRACKETELSE5 ; ELSE - .word XSQUOTE ; S" [THEN]" - .byte 6,"[THEN]" ; - .word COMPARE ; COMPARE - .word QZBRAN,BRACKETELSE6 ; 0= IF - .word ONEMINUS ; 1- -BRACKETELSE6 ; THEN -BRACKETELSE7 ; THEN -BRACKETELSE8 ; THEN - .word QDUP ; ?DUP -; .word QZBRAN,BRACKETELSE9 ; 0= IF - .word QZBRAN,BRACKETELSE2 ; - .word EXIT ; EXIT -;BRACKETELSE9 ; THEN -; .word BRAN,BRACKETELSE2 ; REPEAT -BRACKETELSE10 ; - .word TWODROP ; 2DROP - .word XSQUOTE ; - .byte 5,13,10,"ko " ; - .word TYPE ; CR+LF ." ko " to show false branch of conditionnal compilation - .word REFILL ; REFILL - .word SETIB ; SET Input Buffer pointers SOURCE_LEN, SOURCE_ORG and clear >IN - .word BRAN,BRACKETELSE1 ; AGAIN - - -;[IF] -;https://forth-standard.org/standard/tools/BracketIF + mDOCOL + .word lit,0 +BRACKETELSE0 + .word ONEPLUS ; +BRACKETELSE1 ; + .word FBLANK,WORDD,COUNT ; -- addr u + .word DUP,QFBRAN,BRACKETELSE5 ; u = 0 if end of line --> refill buffer then loop back + .word TWODUP ; + .word XSQUOTE ; + .byte 6,"[THEN]" ; + .word BRBADCOMP,BRACKETELSE2 ; if bad string comparaison, jump for next comparaison + .word BRGOODCMP,BRACKETELSE1 ; 2DROP, count-1, loop back if count <> 0, else DROP + .word EXIT ; then exit +BRACKETELSE2 ; + .word TWODUP ; + .word XSQUOTE ; + .byte 6,"[ELSE]" ; + .word BRBADCOMP,BRACKETELSE3 ; if bad string comparaison, jump for next comparaison + .word BRGOODCMP,BRACKETELSE0 ; 2DROP, count-1, loop back with count+1 if count <> 0, else DROP + .word EXIT ; then exit +BRACKETELSE3 ; + .word XSQUOTE ; + .byte 4,"[IF]" ; + .word BRBADCOMP,BRACKETELSE1 ; if bad string comparaison, loop back + .word BRAN,BRACKETELSE0 ; else loop back with count+1 +BRACKETELSE5 ; + .word TWODROP ; +;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^; +; OPTION ; +5 words option +;vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv; + .word XSQUOTE ; + .byte 5,13,10,"ko " ; + .word TYPE ; CR+LF ." ko " to show false branch of conditionnal compilation +;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^; +BRKTELSEND .word REFILL ; REFILL Input Buffer with next line + .word SETIB ; SET Input Buffer pointers SOURCE_LEN, SOURCE_ORG and clear >IN + .word BRAN,BRACKETELSE1 ; then loop back 44 words without options + + FORTHWORDIMM "[IF]" ; flag -- +; https://forth-standard.org/standard/tools/BracketIF +; [IF] ;Compilation: ;Perform the execution semantics given below. ;Execution: ;( flag | flag "name ..." -- ) @@ -118,31 +190,22 @@ BRACKETELSE10 ; ;If the parse area becomes exhausted, it is refilled as with REFILL. [IF] is an immediate word. ;An ambiguous condition exists if [IF] is POSTPONEd, ; or if the end of the input buffer is reached and cannot be refilled before the terminating [ELSE] or [THEN] is parsed. - FORTHWORDIMM "[IF]" ; flag -- -BRACKETIF - CMP #0,TOS - MOV @PSP+,TOS - JZ BRACKETELSE - mNEXT - -; FORTHWORDIMM "[IFNOT]" ; flag -- -; XOR #-1,TOS -; JMP BRACKETIF - -;[UNDEFINED] -;https://forth-standard.org/standard/tools/BracketUNDEFINED -;Compilation: -;Perform the execution semantics given below. -;Execution: ( "name ..." -- flag ) -;Skip leading space delimiters. Parse name delimited by a space. -;Return a false flag if name is the name of a word that can be found, -;otherwise return a true flag. - FORTHWORDIMM "[UNDEFINED]" - mDOCOL - .word FBLANK,WORDD,FIND,NIP,ZEROEQUAL,EXIT +BRACKETIF CMP #0,TOS ; -- f + MOV @PSP+,TOS ; -- + JZ BRACKETELSE ; false flag output + MOV @IP+,PC ; true flag output + + .IFNDEF NIP +; https://forth-standard.org/standard/core/NIP +; NIP x1 x2 -- x2 Drop the first item below the top of stack +NIP ADD #2,PSP ; 1 + MOV @IP+,PC ; 4 + .ENDIF + -;[DEFINED] -;https://forth-standard.org/standard/tools/BracketDEFINED + FORTHWORDIMM "[DEFINED]" +; https://forth-standard.org/standard/tools/BracketDEFINED +; [DEFINED] ;Compilation: ;Perform the execution semantics given below. ;Execution: @@ -150,38 +213,59 @@ BRACKETIF ;Skip leading space delimiters. Parse name delimited by a space. ;Return a true flag if name is the name of a word that can be found, ;otherwise return a false flag. [DEFINED] is an immediate word. +DEFINED mDOCOL + .word FBLANK,WORDD,FIND,NIP,EXIT + + FORTHWORDIMM "[UNDEFINED]" +; https://forth-standard.org/standard/tools/BracketUNDEFINED +; [UNDEFINED] +;Compilation: +;Perform the execution semantics given below. +;Execution: ( "name ..." -- flag ) +;Skip leading space delimiters. Parse name delimited by a space. +;Return a false flag if name is the name of a word that can be found, +;otherwise return a true flag. + mDOCOL + .word DEFINED,ZEROEQUAL,EXIT + + +; https://forth-standard.org/standard/core/MARKER +; MARKER +;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. + + +; FastForth provides all that is necessary for a real time application next MARKER definition, +; by adding a call to a custom subroutine, with the default parameters to be restored saved next MARKER definition. +MARKER_DOES ; execution part of MARKER, same effect than RST_STATE, but to restore state before MARKER defn. + .word $+2 ; -- BODY + MOV @TOS+,&RST_DP ; -- BODY+2 thus RST_STATE will restore the word-set state before MARKER + .IFDEF VOCABULARY_SET + MOV @TOS+,&RST_VOC ; -- BODY+4 thus RST_STATE will restore the word-set state before MARKER + .ELSE + ADD #2,TOS ; -- BODY+4 + .ENDIF + CALL @TOS+ ; -- BODY+6 @TOS = RET_ADR|STOP_APP_ADR (default|custom) + MOV @PSP+,TOS ; -- + MOV @RSP+,IP ; + JMP RST_STATE ; then next + + FORTHWORD "MARKER" ; definition part +;( "name" -- ) +;Skip leading space delimiters. Parse name delimited by a space. Create a definition for name +;with the execution semantics defined below. - FORTHWORDIMM "[DEFINED]" - mDOCOL - .word FBLANK,WORDD,FIND,NIP,EXIT - -;; CORE EXT MARKER -;;https://forth-standard.org/standard/core/MARKER -;;( "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_DOES FORTHtoASM ; execution part - 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 ; -- - JMP RST_STATE ; execute RST_STATE, PWR_STATE then STATE_DOES - - FORTHWORD "MARKER" ; definition part - CALL #HEADER ;4 W = DP+4 - MOV #DODOES,-4(W) ;4 CFA = DODOES - MOV #MARKER_DOES,-2(W) ;4 PFA = MARKER_DOES - MOV &LASTVOC,0(W) ;5 [BODY] = VOCLINK to be restored - SUB #2,Y ;1 Y = LFA - MOV Y,2(W) ;3 [BODY+2] = LFA = DP to be restored - ADD #4,&DDP ;3 - - - ; the next in forthMSP430FR.asm is GOOD_CSP + CALL #HEADER ;4 W = DP+4, Y = NFA, + MOV #1285h,-4(W) ;4 CFA = CALL R5 = rDODOES + MOV #MARKER_DOES,-2(W) ;4 PFA = MARKER_DOES + SUB #2,Y ;1 Y = NFA-2 = LFA + MOV Y,0(W) ;3 BODY = DP value before this MARKER definition + .IFDEF VOCABULARY_SET + MOV &LASTVOC,2(W) ;5 BODY+2 = current VOCLINK + .ENDIF + MOV #RET_ADR,4(W) ; BODY+4 = RET addr, to do nothing by default + ADD #6,&DDP ;4 + JMP GOOD_CSP ;