From 67d25d837ac55f28a366c0a3b262e439a6e75fc3 Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Sat, 19 Aug 2017 12:15:28 +0200 Subject: Add AmForth --- amforth-6.5/common/words/accept.asm | 95 +++++++++++++++++++++++++++++++++++++ 1 file changed, 95 insertions(+) create mode 100644 amforth-6.5/common/words/accept.asm (limited to 'amforth-6.5/common/words/accept.asm') diff --git a/amforth-6.5/common/words/accept.asm b/amforth-6.5/common/words/accept.asm new file mode 100644 index 0000000..68afdb1 --- /dev/null +++ b/amforth-6.5/common/words/accept.asm @@ -0,0 +1,95 @@ + +.if cpu_msp430==1 + HEADER(XT_ACCEPT,6,"accept",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_ACCEPT: + .dw $ff06 + .db "accept" + .dw VE_HEAD + .set VE_HEAD = VE_ACCEPT +XT_ACCEPT: + .dw DO_COLON +PFA_ACCEPT: + +.endif + .DW XT_OVER,XT_PLUS,XT_1MINUS,XT_OVER +ACC1: .DW XT_KEY,XT_DUP,XT_CRLFQ,XT_ZEROEQUAL,XT_DOCONDBRANCH + DEST(ACC5) + .DW XT_DUP,XT_DOLITERAL,8,XT_EQUAL,XT_DOCONDBRANCH + DEST(ACC3) + .DW XT_DROP,XT_ROT,XT_2DUP,XT_GREATER,XT_TO_R,XT_ROT,XT_ROT,XT_R_FROM,XT_DOCONDBRANCH + DEST(ACC6) + .DW XT_BS,XT_1MINUS,XT_TO_R,XT_OVER,XT_R_FROM,XT_UMAX +ACC6: .DW XT_DOBRANCH + DEST(ACC4) + + +ACC3: ; check for remaining control characters, replace them with blank + .dw XT_DUP ; ( -- addr k k ) + .dw XT_BL + .dw XT_LESS + .dw XT_DOCONDBRANCH + DEST(PFA_ACCEPT6) + .dw XT_DROP + .dw XT_BL +PFA_ACCEPT6: + .DW XT_DUP,XT_EMIT,XT_OVER,XT_CSTORE,XT_1PLUS,XT_OVER,XT_UMIN +ACC4: .DW XT_DOBRANCH + DEST(ACC1) +ACC5: .DW XT_DROP,XT_NIP,XT_SWAP,XT_MINUS,XT_CR,XT_EXIT + + +; ( -- ) +; System +; send a backspace character to overwrite the current char +.if cpu_msp430==1 + HEADLESS(XT_BS,DOCOLON) +.endif + +.if cpu_avr8==1 + +;VE_BS: +; .dw $ff02 +; .db "bs" +; .dw VE_HEAD +; .set VE_HEAD = VE_BS +XT_BS: + .dw DO_COLON +.endif + .dw XT_DOLITERAL + .dw 8 + .dw XT_DUP + .dw XT_EMIT + .dw XT_SPACE + .dw XT_EMIT + .dw XT_EXIT + + +; ( c -- f ) +; System +; is the character a line end character? +.if cpu_msp430==1 + HEADLESS(XT_CRLFQ,DOCOLON) +.endif + +.if cpu_avr8==1 +;VE_CRLFQ: +; .dw $ff02 +; .db "crlf?" +; .dw VE_HEAD +; .set VE_HEAD = VE_CRLFQ +XT_CRLFQ: + .dw DO_COLON +.endif + .dw XT_DUP + .dw XT_DOLITERAL + .dw 13 + .dw XT_EQUAL + .dw XT_SWAP + .dw XT_DOLITERAL + .dw 10 + .dw XT_EQUAL + .dw XT_OR + .dw XT_EXIT -- cgit v1.2.3