awkで書いたforthもどきその１

　ふと思い立ってawkでforth書けないかなとやってみた。ただしリターンスタックは現在使っておらず逆ポーランド電卓レベル。ワードも今は定義するだけ。
　gawk4.0.0が必要。split関数で4番目の引数(セパレータの格納)を使っているため。
　パラメータスタックを毎回操作しているがもちろん直接参照すれば速いとは思います。分かりやすさ優先。
　forthではスタックに積む値は16ビットの固定幅ですが、awkで書いてあるためawkで扱える値が積めます。ただ参照するときにそのままでは使えないので連想配列で参照する予定。

#! /usr/local/bin/gawk -f
#
# FORTH inerpreter by awk
#
# 2012.05.07 Pstack & standard op
# 2012.05.09 ( comment) & ." string"
# 2012.05.10 word
#
#
BEGIN{
	Pptr=0	# Parameter Stack Pointer
	Rptr=0	# Return Stack Pointer
	Pmax=30000
	Rmax=30000

	P[0]=""	# Parameter Stack
	R[0]=""	# Return Stack
	M[0]=""	# Memory

	TRUE=-1
	FALSE=0

	Printbegin=""
	Printend=""
	string=""
	Comment=""
	Compile=""

	print "* awkforth *"
	print "--"
}
{
	r=eval($0);
	if (r==0) {
		if (Compile!="") {
			print " compiled"
		} else {
			print " ok"
		}
	} else {
		print "ERR: " r
	}
}


function eval(str ,i,j,num,w,wj){
	num = split(str,word,FS,word_sep)
	for(i=1;i<=num;i++) {
		w=word[i];
		if(Compile=="" && w==":") {	# compile mode
			Compile=":"
			continue
		}
		if(Compile==":") {	# compile word
			Compile=w
			Word[Compile]=""
			continue
		}
		if(Compile!="") {	# compile
			if (w==";") {
				Compile=""
			} else {
				Word[Compile]=Word[Compile] " " w
			}
			continue
		}

		if (w=="(") {	# comment
			Comment="("
			continue
		}
		if (Comment!="" && substr(w,length(w),1)==")") {
			Comment=""
			continue
		}

		if (w==".\"" || w==".'") {
			Printbegin=w
			Printend=last(w)
			continue
		}
		if (Printbegin!="") {
			for(j=i;j<=num;j++) {
				i++
				wj=word[j]
				if (wj==Printbegin) continue ;
				if(last(wj)==Printend) {
					string = string head(wj)
					print string
					string=""
					PrintBegin=""
					break
				}
				string=string wj
				if (j<num) string=string word_sep[j]
			}
		}

		if ((nerr=isnum(w))&&(oerr=isop(w))) {
			return nerr+oerr
		}
	}
	return 0
}

function push(n) {
	if (Pptr>=Pmax) {
		print "# P Stack Overflow!"
		return 0
	}
	P[Pptr]=n
	Pptr++
}
function pop( n) {
	if (Pptr<=0) {
		print "# P stack Underflow!"
		return 0
	}
	--Pptr
	n=P[Pptr]
	return n
}

function last(word){
	return substr(word,length(word),1)
}
function head(word){
	return substr(word,1,length(word)-1)
}

function isnum(n) {
	if (n~"^[-]*[0-9]+$") {
		push(n);
		return 0
	} else {
		return 1
	}
}

function isop(x ,t,n,nn,r) {
	switch(x) {
	case ".":	# . ( n -- )
		print " " pop()
		r=0;break
	case "+":	# ( n1 n2 -- n2+n1 )
		t=pop();push(pop()+t)
		r=0;break
	case "-":	# ( n1 n2 -- n2-n1 )
		t=pop();push(pop()-t)
		r=0;break
	case "*":	# ( n1 n2 -- n2*n1 )
		t=pop();push(pop()*t)
		r=0;break
	case "/":	# ( n1 n2 -- n2/n1 )
		t=pop();push(pop()/t)
		r=0;break
	case "1+":	# ( n -- n+1 )
		t=pop();push(t+1)
		r=0;break
	case "1-":	# ( n -- n-1 )
		t=pop();push(t-1)
		r=0;break
	case "NEGATE":	# ( n -- -n )
		t=pop();push(-t)
		r=0;break
	case "ABS":	# ( n -- |n| )
		t=pop();push(t+0<0?-t:t+0)
		r=0;break
	case "MAX":	# ( n1 n2 -- n3 )
		t=pop();n=pop()
		push(t>n?t:n)
		r=0;break
	case "MIN":	# ( n1 n2 -- n3 )
		t=pop();n=pop()
		push(t<n?t:n)
		r=0;break
	case "<":	# ( n1 n2 -- n3 )
		t=pop();n=pop()
		push(n<t?TRUE:FALSE)
		r=0;break
	case ">":	# ( n1 n2 -- n3 )
		t=pop();n=pop()
		push(n>t?TRUE:FALSE)
		r=0;break
	case "DROP":	# ( n -- )
		pop()
		r=0;break
	case "DUP":	# ( n -- n n )
		t=pop();push(t);push(t)
		r=0;break
	case "DDUP":	# ( n -- n n n )
		t=pop();push(t);push(t);push(t)
		r=0;break
	case "OVER":	# ( n1 n2 -- n1 n2 n1 )
		t=pop();n=pop();push(n);push(t);push(n)
		r=0;break
	case "ROT":	# ( n1 n2 n3 -- n2 n3 n1 )
		t=pop();n=pop();nn=pop()
		push(n);push(t);push(nn)
		r=0;break
	case "SWAP":	# ( n1 n2 -- n2 n1 )
		t=pop();n=pop()
		push(t);push(n)
		r=0;break
	case "VLIST":	# ( -- )
		for(t in Word) {
			print t
		}
		r=0;break
	default:
		r=n
	}
	return r
}