// 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)
//   public release som v5.0   5 Dec 2009   (Long live the King)

enum
    80 maxcol				// max depth of nested indent

//  101  mode
//  102  tokvalue
//  103  tokcol
//  104  line
//  250..299 tokstring

: 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 = 250			// M[250..299] 70 char
    // 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

//to testtok | t fp  =
//	fp = fopen 110 0   // src_file
//	t = syslex fp
//	while t != tkEOF
//		prtoken t space
//		t = syslex fp
//	fclose fp

// end

