REM >tableGen
REM
REM Generates a lex table for BASIC keywords, and outputs it in
REM objasm syntax
REM
REM © 1995 Straylight
REM
:
PROCinit
tab$=CHR$(9)
PROCgetClasses
PROCoutputTokens
PROCoutputNames
PROCoutputTable
END
:
DEFPROCinit
ONERROR PRINTREPORT$;" [";STR$(ERL);"]":CLOSE#0:END
DIM block% 20240
DIM tokenClass%(256)
DIM classNames$(256)
DIM tokenCount%(256)
tokenClass%()=-1
nClass%=1
ptr%=block%
ptr%!0=0
ptr%!4=0
ptr%!8=0
ntable%=1
ENDPROC
:
DEFPROCgetClasses
LOCAL i%,k$,c$,c%,t%,this%,C
RESTORE
READ k$,c$
t%=128
WHILE k$<>"***"
  c%=-1
  FOR i%=0 TO nClass%
    IF classNames$(i%)=c$ THEN c%=i%
  NEXT
  IF c%=-1 THEN
    c%=nClass%
    nClass%+=1
    classNames$(c%)=c$
  ENDIF
  IF LEN(k$)=1 THEN
    this%=ASC(k$)
  ELSE
    this%=t%
    t%+=1
  ENDIF
  tokenClass%(this%)=c%+(tokenCount%(c%)<<16)
  tokenCount%(c%)+=1
  READ k$,c$
ENDWHILE

C=OPENOUT("sh.tokClasses")
BPUT#C,";"
BPUT#C,"; tokClasses.sh"
BPUT#C,";"
BPUT#C,"; Token class and index tables (generated)"
BPUT#C,";"
BPUT#C,"; © 1995 Straylight"
BPUT#C,";"
BPUT#C,""
BPUT#C,tab$+tab$+"["+tab$+":LNOT::DEF:tokClasses__dfn"
BPUT#C,tab$+tab$+"GBLL"+tab$+"tokClasses__dfn"
BPUT#C,""
BPUT#C,"tokClasses"
FOR i%=0 TO 255
  IF tokenClass%(i%)=-1 THEN
    BPUT#C,tab$+tab$+"DCB"+tab$+"0,0"
  ELSE
    BPUT#C,tab$+tab$+"DCB"+tab$+STR$(tokenClass%(i%) AND &FFFF)+",";
    BPUT#C,STR$(tokenClass%(i%) >> 16)
  ENDIF
NEXT
BPUT#C,""
BPUT#C,tab$+tab$+"]"
BPUT#C,"" 
BPUT#C,tab$+tab$+"END"
CLOSE#C
OSCLI "SetType sh.tokClasses text"
ENDPROC
:
DEFPROCoutputTokens
LOCAL C,key$
C=OPENOUT("sh.tokens")
BPUT#C,";"
BPUT#C,"; tokens.sh"
BPUT#C,";"
BPUT#C,"; Define constants for the tokens (generated)"
BPUT#C,";"
BPUT#C,"; © 1995 Straylight"
BPUT#C,";"
BPUT#C,""
BPUT#C,tab$+tab$+"["+tab$+":LNOT::DEF:tokens__dfn"
BPUT#C,tab$+tab$+"GBLL"+tab$+"tokens__dfn"
BPUT#C,""
BPUT#C,tab$+tab$+"^"+tab$+"&80"
RESTORE
READ key$,c$
WHILE key$<>"***"
  IF LEN(key$)>1 THEN
    key$=FNnice(key$)
    BPUT#C,key$;
    IF LEN(key$)>7 THEN BPUT#C,tab$; ELSE BPUT#C,tab$+tab$;
    BPUT#C,"#"+tab$+"1"
  ENDIF
  READ key$,c$
ENDWHILE
BPUT#C,""
BPUT#C,tab$+tab$+"^"+tab$+"1"
FOR i%=1 TO nClass%-1
  c$="tClass_"+classNames$(i%)
  BPUT#C,c$;
  IF LEN(c$)<8 THEN BPUT#C,tab$+tab$; ELSE BPUT#C,tab$;
  BPUT#C,"#"+tab$+"1"
NEXT
BPUT#C,""
BPUT#C,tab$+tab$+"]"
BPUT#C,""
BPUT#C,tab$+tab$+"END"
CLOSE#C
OSCLI("Settype sh.tokens text")
ENDPROC
:
DEFPROCoutputNames
LOCAL C,key$,i%
C=OPENOUT("sh.tokNames")
BPUT#C,";"
BPUT#C,"; tokNames.sh"
BPUT#C,";"
BPUT#C,"; Number-to-name table for tokens (generated)"
BPUT#C,";"
BPUT#C,"; © 1995 Straylight"
BPUT#C,";"
BPUT#C,""
BPUT#C,tab$+tab$+"["+tab$+":LNOT::DEF:tokNames__dfn"
BPUT#C,tab$+tab$+"GBLL"+tab$+"tokNames__dfn"
BPUT#C,""
BPUT#C,"tokNames";

i%=0
RESTORE
READ key$,c$
WHILE key$<>"***"
  IF LEN(key$)>1 THEN
    IF i%=0 THEN BPUT#C,tab$; ELSE BPUT#C,tab$+tab$;
    BPUT#C,"DCD"+tab$+"tn__"+STR$(i%)
    i%+=1
  ENDIF
  READ key$,c$
ENDWHILE
BPUT#C,""
RESTORE
READ key$,c$
i%=0
WHILE key$<>"***"
  IF LEN(key$)>1 THEN
    BPUT#C,"tn__"+STR$(i%)+tab$+tab$+"DCB"+tab$+""""+key$+""",0"
    i%+=1
  ENDIF
  READ key$,c$
ENDWHILE
BPUT#C,""
BPUT#C,tab$+tab$+"]"
BPUT#C,""
BPUT#C,tab$+tab$+"END"
CLOSE#C
OSCLI("Settype sh.tokNames text")
ENDPROC
:
DEFPROCoutputTable
RESTORE
READ key$,c$
root%=0
WHILE key$<>"***"  
  PROCaddAcross(root%,key$)
  READ key$,c$
ENDWHILE
C=OPENOUT"sh.tokTable"
BPUT#C,";"
BPUT#C,"; tokTable.sh"
BPUT#C,";"
BPUT#C,"; State table for lexical analysis (generated)"
BPUT#C,";"
BPUT#C,"; © 1995 Straylight"
BPUT#C,";"
BPUT#C,""
BPUT#C,tab$+tab$+"["+tab$+":LNOT::DEF:tokTable__dfn"
BPUT#C,tab$+tab$+"GBLL"+tab$+"tokTable__dfn"
BPUT#C,""
BPUT#C,tab$+tab$+"MACRO"
BPUT#C,"$label"+tab$+tab$+"TOKTBL"+tab$+"$char,$next,$token"
BPUT#C,"$label"
BPUT#C,tab$+tab$+"["+tab$+"""$next""=""0"""
BPUT#C,tab$+tab$+"DCW"+tab$+"0"
BPUT#C,tab$+tab$+"|"
BPUT#C,tab$+tab$+"DCW"+tab$+"$next-kt0"
BPUT#C,tab$+tab$+"]"
BPUT#C,tab$+tab$+"["+tab$+"""$token""<>"""""
BPUT#C,tab$+tab$+"DCB"+tab$+"$token"
BPUT#C,tab$+tab$+"|"
BPUT#C,tab$+tab$+"DCB"+tab$+"0"
BPUT#C,tab$+tab$+"]"
BPUT#C,tab$+tab$+"DCB"+tab$+"$char"
BPUT#C,tab$+tab$+"MEND"
BPUT#C,""
BPUT#C,"tokTable"
PROCoutputBlock(C,block%,0,"")
BPUT#C,tab$+tab$+"]"
BPUT#C,""
BPUT#C,tab$+tab$+"END"
CLOSE#C
OSCLI("Settype sh.tokTable text")
ENDPROC
:
DEFFNnice(s$)
LOCAL nice$,c%
IF LEN(s$)=1 THEN ="'"+s$+"'"
nice$="tok_"
WHILE s$<>""
  c%=ASC(LEFT$(s$,1))
  c%=c% OR &20
  IF c%>&60 AND c%<&7B THEN
    nice$+=CHR$(c%)
  ELSE
    CASE CHR$(c%) OF
      WHEN "+": nice$+="P"
      WHEN "-": nice$+="M"
      WHEN "*": nice$+="T"
      WHEN "/": nice$+="D"
      WHEN "=": nice$+="E"
      WHEN "<": nice$+="L"
      WHEN ">": nice$+="G"
      WHEN "$": nice$+="S"
      WHEN "#": nice$+="H"
    ENDCASE
  ENDIF
  s$=MID$(s$,2)
ENDWHILE
=nice$
:
DEF PROCaddAcross(p%,s$)
old%=0
last%=0
WHILE s$<>""
  c%=ASC(LEFT$(s$,1))
  IF p%=0 THEN
    IF old% THEN old%!0=ptr% ELSE root%=ptr%
    p%=ptr%
    ptr%!0=c%
    ptr%!4=0
    ptr%!8=0
    ptr%+=12
    s$=MID$(s$,2)
    old%=p%+8
    last%=p%
    p%=p%!8
  ELSE  
    IF c%=?p% THEN
      old%=p%+8
      last%=p%
      p%=p%!8
      s$=MID$(s$,2)
    ELSE
      old%=p%+4
      p%=p%!4
    ENDIF
  ENDIF
ENDWHILE
last%!0=last%!0 OR (1<<31)
ENDPROC
:
DEFPROCdisplayBlock(blk%,indent%)
IF blk%<>0 THEN
  PRINT CHR$(blk%!0);
  PROCdisplayBlock(blk%!8,indent%+1)
  IF blk%!4 THEN
    PRINT SPC(indent%);
    PROCdisplayBlock(blk%!4,indent%)
  ENDIF
ELSE
  PRINT
ENDIF
ENDPROC
:
DEFPROCoutputBlock(C,blk%,n%,prefix$)
BPUT#C,"kt"+STR$(n%);
PROCoutputAcross(C,blk%,prefix$)
ENDPROC
:
DEFPROCoutputAcross(C,p%,prefix$)
LOCAL n%
n%=ntable%
IF p%<>0 THEN
  BPUT#C,tab$+tab$+"TOKTBL"+tab$+"'"+CHR$(p%?0)+"'";
  IF p%!8 THEN
    BPUT#C,",kt"+STR$(n%);
    ntable%+=1
  ELSE
    BPUT#C,",0";
  ENDIF
  IF (p%!0 AND (1<<31)) THEN
    BPUT#C,","+FNnice(prefix$+CHR$(?p%));
  ENDIF
  BPUT#C,""
  PROCoutputAcross(C,p%!4,prefix$)
  IF p%!8 THEN PROCoutputBlock(C,p%!8,n%,prefix$+CHR$(?p%))
ELSE
  BPUT#C,tab$+tab$+"TOKTBL"+tab$+"0,0"
  BPUT#C,""
ENDIF
ENDPROC
:
DATA AND,andOp,ABS,fn,ASC,fn
DATA BGET,streamOp,BPUT,instr,
DATA CASE,instr,CHR$,fn,CLOSE,instr
DATA CALL,instr
DATA DATA,instr,DEF,instr,DIV,multOp,DIM,instr
DATA END,instr,ENDPROC,instr,ENDWHILE,instr,ENDIF,instr,ENDCASE,instr
DATA ELSE,instr,EVAL,fn,ERROR,instr,EOF,streamOp,EOR,orOp
DATA EXT,streamOp
DATA FOR,instr,FALSE,pseud,FN,odd,GOTO,instr
DATA GET$,streamOp,GOSUB,instr
DATA IF,instr,INSTR(,multArg,LEFT$(,multArg,LEN,fn
DATA LET,instr
DATA LOCAL,instr
DATA MID$(,multArg,MOD,multOp
DATA NEXT,instr,NOT,fn
DATA OF,noise,OFF,option,ON,noise,OR,orOp,OPENIN,fn,OPENOUT,fn,OPENUP,fn
DATA OSCLI,instr,OTHERWISE,instr
DATA PTR,streamOp,PROC,instr
DATA RETURN,instr,REPEAT,instr,READ,instr
DATA REM,noise,RESTORE,instr
DATA RIGHT$(,multArg,RND,odd
DATA STEP,noise,SGN,fn,STR$,fn,STRING$(,multArg,SWAP,instr
DATA SYS,instr
DATA THEN,noise,TIME,pseud,TIME$,pseud,TO,noise,TRUE,pseud
DATA UNTIL,instr
DATA VAL,fn
DATA WHILE,instr,WHEN,instr
DATA =,relOp,<,relOp,<=,relOp,<>,relOp,>,relOp,>=,relOp
DATA <<,relOp,>>,relOp,>>>,relOp
DATA /,multOp,/*,noise,//,noise
DATA +,addOp,-,addOp,*,multOp,+=,assign,-=,assign,*=,assign,^,powOp
DATA /=,assign
DATA ***,***