( brainfuck interpreter )

%!~ { NEQk NIP }
%DEC { #01 SUB }
%DEC2 { #0001 SUB2 }
%DECr { LITr 01 SUBr }
%RTN { JMP2r }
%HALT { #0101 #0e DEO2 }
%EMIT { #18 DEO }

%MEMORY { #8000 }

|0000

@pointer $2

|0100 ( -> )

	MEMORY .pointer STZ2

	;program
	&while
		LDAk ,op JSR
		INC2 LDAk ,&while JCN
	POP2

	HALT
	
BRK

(
	> Move the pointer to the right
	< Move the pointer to the left
	+ Increment the memory cell at the pointer
	- Decrement the memory cell at the pointer
	[ Jump past the matching ] if the cell at the pointer is 0
	] Jump back to the matching [ if the cell at the pointer is nonzero
	, Input a character and store it in the cell at the pointer
	. Output the character signified by the cell at the pointer )

@op ( op -- )

	LIT '> !~ ,&right JCN
		.pointer LDZ2k INC2 ROT STZ2 
		POP RTN &right
	LIT '< !~ ,&left JCN
		.pointer LDZ2k DEC2 ROT STZ2 
		POP RTN &left
	LIT '+ !~ ,&inc JCN
		.pointer LDZ2 STH2k LDA INC STH2r STA 
		POP RTN &inc
	LIT '- !~ ,&dec JCN
		.pointer LDZ2 STH2k LDA DEC STH2r STA
		POP RTN &dec
	LIT '. !~ ,&emit JCN
		.pointer LDZ2 LDA EMIT
		POP RTN &emit
	LIT '[ !~ ,&next JCN
		POP  ,goto-next JSR
		RTN &next
	LIT '] !~ ,&prev JCN
		POP ,goto-back JSR
		RTN &prev
	POP

RTN

@goto-next ( -- )

	.pointer LDZ2 LDA #00 EQU JMP RTN

	( depth ) LITr 00
	INC2
	&loop
		LDAk LIT '[ NEQ ,&no-depth JCN
			INCr
			&no-depth
		LDAk LIT '] NEQ ,&no-end JCN
			STHkr #00 EQU ,&end JCN
			DECr
			&no-end
		INC2 LDAk ,&loop JCN
	&end
	( depth ) POPr

RTN

@goto-back ( -- )

	.pointer LDZ2 LDA #00 NEQ JMP RTN

	( depth ) LITr 00
	DEC2
	&loop
		LDAk LIT '] NEQ ,&no-depth JCN
			INCr
			&no-depth
		LDAk LIT '[ NEQ ,&no-end JCN
			STHkr #00 EQU ,&end JCN
			DECr
			&no-end
		DEC2 LDAk ,&loop JCN
	&end
	( depth ) POPr

RTN

@program ( Hello World! )

	2b 2b 2b 2b 2b 2b 2b 2b 5b 3e 2b 2b 2b 2b 5b 3e 
	2b 2b 3e 2b 2b 2b 3e 2b 2b 2b 3e 2b 3c 3c 3c 3c 
	2d 5d 3e 2b 3e 2b 3e 2d 3e 3e 2b 5b 3c 5d 3c 2d 
	5d 3e 3e 2e 3e 2d 2d 2d 2e 2b 2b 2b 2b 2b 2b 2b 
	2e 2e 2b 2b 2b 2e 3e 3e 2e 3c 2d 2e 3c 2e 2b 2b 
	2b 2e 2d 2d 2d 2d 2d 2d 2e 2d 2d 2d 2d 2d 2d 2d 
	2d 2e 3e 3e 2b 2e 3e 2b 2b 2e 0a