X-Git-Url: https://git.distorted.org.uk/~mdw/ssr/blobdiff_plain/a3da4c116d4216fdec125d687dfc347e343a8b28..c1b567d833a004bb3d978f1f7c99f42cefa7845c:/StraySrc/Libraries/Sapphire/sail/tableGen.bas

diff --git a/StraySrc/Libraries/Sapphire/sail/tableGen.bas b/StraySrc/Libraries/Sapphire/sail/tableGen.bas
new file mode 100644
index 0000000..393e861
--- /dev/null
+++ b/StraySrc/Libraries/Sapphire/sail/tableGen.bas
@@ -0,0 +1,350 @@
+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 ***,***