// token-s.txt
//   public release som v3.0   5 March 2007 (Maka-bucha day)
//   public release som v3.1   19 Aug 2007 (Draft vote day)
//   public release som v4.0   2 July 2008
//   public release som v4.1   9 Aug 2008 (Birthday)
//	 public release som v4.2   9 Sept 2009 (triple 9, 9/9/2009)

enum
	80 maxcol				// max depth of nested indent

//  1..80 tokstring
//  101  mode
//  102  tokvalue
//  103  tokcol
//  104  line

: tokvalue = M[102]
: tokcol = M[103]
: settokvalue x = M[102] = x

to initlex =
//	inbuf = array 1000		// input line buffer
	tok = 0					// current token
//	tokvalue = 0			// token value
//	tokstring = array 256	// token string
	tokstring = 1			// M[1..80]
	// column stack for block indentation
//	tokcol = 0				// current token column
	colstk = array maxcol	// column stack
	colsp = 0

to pushcol col =
	if colsp >= maxcol
		seterror "lex error col stack overflow"
	else
		colsp = colsp + 1
		colstk[colsp] = col

to popcol =
	if colsp <= 0
		seterror "lex error col stack underflow"
	else
		colsp = colsp - 1

to startlex =
//	CLEN = 0				// current token length
//	TP = 0					// current token pointer
//	line = 0				// current line number
	setline 0
	lexstate = 1			// state of lex
	oldtok = 0				// old token
	colsp = 0				// col stack pointer
	pushcol 0

to prtoken tk | a = {}

to lex2 =
	tok = syslex FI
	if tok == tkIDEN
//		tokvalue = install tokstring
		settokvalue (install tokstring)
		if (getType tokvalue) == tyKEY // key word
			tok = getRef tokvalue

// lexstate N=1, F=2, B=3
// state description   condition  action    next
//   N  normal  lex     oldline   out tok     N
//   N                  nl & ==   out tok     N
//   N                  nl & >    out { push  F
//   N                  nl & <    out } pop   B
//   F  forward         -         out oldtok  N
//   B  backward        ==        out oldtok  N
//   B                  <         out } pop   B
//   transition occurs on call lex
//   eof is a special case

to lex | oldline =
	case lexstate
		1:	// normal
			oldline = line
//			lex1					// at token-old-s.txt
			lex2
//			printc 34 prtoken tok printc 34 space
			oldtok = tok
			if tok == tkEOF			// out BE til match
				if colstk[colsp] != 0
					tok = tkBE
					popcol
				break
			if line != oldline		// newline
				if tokcol > colstk[colsp]
					tok = tkBB
					pushcol tokcol
					lexstate = 2	// F
				else if tokcol < colstk[colsp]
					tok = tkBE
					popcol
					lexstate = 3	// B
				// tokcol == colstk, just return tok
		2:	// forward
			tok = oldtok
			lexstate = 1			// N
		3:	// backward
			if tokcol >= colstk[colsp]
				tok = oldtok
				lexstate = 1		// N
			else // if tokcol < colstk[colsp]
				tok = tkBE
				popcol

// original prtoken (in som-v2) is 251 words
// this version using tok_str is 41 words

// print string of token, len 3 each
tok_str = array
	"*" 0 "/" 0 "-" 0 "+" 0 "=" 0 "==" 0 "&" 0 "|" 0
	"^" 0 "%" 0 "!" 0 "!=" 0 "<" 0 "<=" 0 "<<" 0 ">" 0
	">=" 0 ">>" 0 ":" 0 "(" 0 ")" 0 "[" 0 "]" 0 "{" 0
	"}" 0 "to" 0 "if" 0 "else" 0 "while" "for" 0 "break" "array"
	"case" 0 "enum" 0 "syscall"

to prtoken tk | a =
	if tk > tkSYSCALL
		seterror "unknown token"
	if tk >= tkSTAR
		a = tk - tkSTAR		// a 0..34
		prints tok_str+(a*3)
		break
	case tk
		tkIDEN: prints tokstring
		tkNUMBER: print tokvalue
		tkSTRING:
			printc 34 prints tokstring printc 34
		tkEOF: prints "eof"

// print atom
to pratom type ref =
	case type
		SP:
			prints "NIL"
		OPER:
			prtoken ref
		ADS:
			printc 36 print ref	// $
		NUM:
			print ref
		GNAME:
			prints getName ref
		LNAME:
			printc 35 print ref // #
		CNAME:
			prints "classname"
		STRING:
			printc 34 prints ref printc 34

// print list
to prlist a =
	if a == NIL break
	if isatom a
		pratom (car a) (cdr a)
		space
	else
		printc 40   // "("
		while a != NIL
			prlist car a
			a = cdr a
		printc 41   // ")"

to enterKey nm ref | a =
	a = install nm
	setType a tyKEY
	setRef a ref

to initkeysym =
	init_symtab
	enterKey "to" tkTO
	enterKey "if" tkIF
	enterKey "else" tkELSE
	enterKey "while" tkWHILE
	enterKey "for" tkFOR
	enterKey "break" tkBREAK
	enterKey "array" tkARRAY
	enterKey "case" tkCASE
	enterKey "enum" tkENUM
	enterKey "syscall" tkSYSCALL

// end

