meta pi compiler compiler

Applications, Games, Tools, User libs and useful stuff coded in PureBasic
Post Reply
startup
Enthusiast
Enthusiast
Posts: 105
Joined: Wed Feb 25, 2015 5:55 pm

meta pi compiler compiler

Post by startup »

A little meta pi compiler ported from an old asm generator (6502 - that how old it is). most of it is generated with itself.

generates compiler and prototypes includes scanner
needs user interface - easy to understand by looking at source

NEEDS a maintainer !!!!!!!!!!!!!!!!!!! so anybody interested take optimize and share the sources.



RUDIMENTARY error recognition
:= separate rulename from rule
() group
| alternative
; end of rule
$ - 0 or more
? () preview


Code: Select all

pointerheader := "*" SEM_a1 .ID SEM_a1 "." SEM_a1 ("integer"|"string"|"double"|"Float"|"Quad"|"Unicode"|"Character"|"byte"|"Ascii"|.ID) SEM_a1 
                    $("," SEM_a1 "*" SEM_a1 .ID SEM_a1 "." SEM_a1 ("integer"|"string"|"double"|"Float"|"Quad"|"Unicode"|"Character"|"byte"|"Ascii"|.ID) SEM_a1) ;
?()	look ahead, if true continue

. functionname call function
: make an attribute


Code: Select all

prim   := "." .ID:xxx  SEM17 "("(.ID|.INT|.GETSTRING) SEM13

test := .pointerheader(@tester, ttt, "ffff") ; call functions with attributes
test xxxx(*scan.scan, x.i) := .pointerheader(@tester, ttt, "ffff") ; attribute a rule
@@ ... @@ user code insertion, must start and end on own line


Code: Select all

prim   := "." .ID SEM17 ("(" SEM13
                            callheader $("," SEM13 callheader)

                        ")" SEM12 
                        |
                      @@ 
                          perr = 1 
                      @@ 
                        
                        )  ;

split with semantic rules - portability for other languages such as asm etc

Code: Select all

SEM1 := .EMIT("Procedure.i ") .EMIT("_OUT") .EMIT("()") .FLUSH .EMIT("  Protected  perr.i = 0") .FLUSH ;

Code: Select all

#SCREEN	show/dont show on screen
#TRACE	insert trace  source
#MAIN float1	define main function
#LABEL prim	change label names
#LIB scan	insert library file
#END		end of file or library file
[/size]

some old, old bfn for a ‘C’ port - does not represent this generator

Code: Select all

// #LIB scan
//#TRACE
#MAIN prog
#LABEL newer1
// #LIB MC4

prog := stmt $stmt "#END";
stmt  := .ID SEM1 ":=" entry $( "|" entry) SEM4 .SYNC2(";") ";" ;
entry := elem $elem2 SEM6 ;
elem  := typ1 SEM8 | typ2 SEM2 | prim SEM8 ;
elem2 := typ1 | typ2 SEM5 | prim ;
typ1  := codes | to | recurs | getcode | next | snm | labels | look | zero;
typ2  := expr |.ID SEM9 |.GETSTRING SEM10
         | ".ID" SEM19 {":" .ID SEM30}
         | ".INT" SEM20 {":" .ID SEM30}
         | ".GETSTRING" SEM21 {":" .ID SEM30}
         | ".LABEL(" SEM25 ;
expr  := "(" SEM23 elemxp ")" SEM7;
zero  := "{" SEM23 (elemxp|SEM35) "}" SEM27;

elemxp:= entry2 $("|" SEM3 entry2) ;
entry2:= elem $elem2 SEM7 ;
codes := "@@" .FLUSH .EMIT("; ----------------------------  START OF USER CODE ----------------------------  ")
         .FLUSH .CODE("@@") .FLUSH
         .EMIT("; ----------------------------  END OF USER CODE ----------------------------  ")
         .FLUSH .FLUSH ;
to      := ".SYNC2" "(" .GETSTRING .EMIT("SYNC2(") .EMIT("_OUT")  ")" .EMIT(");") .FLUSH ;
getcode := ".COLLECT2" "(" .GETSTRING .EMIT("COLLECT2(") .EMIT("_OUT")  ")"
           .EMIT(");") .FLUSH .EMIT("if(Token.ParseFlag == 0) return;") .FLUSH ;
recurs := "$" SEM14 elem SEM15 ;
look   := "?" SEM28 elem SEM16 ;
next   := ".FLUSH" SEM18 ;
prim   := "." .ID SEM17 "("(.ID|.INT|.GETSTRING) SEM13 
          $("," SEM13 (.ID|.INT|.GETSTRING) SEM13) ")" SEM12 ;
snm    := "SEM" .EMIT("  ") .EMIT("_OUT") (.INT | "_" .EMIT("_OUT") .ID) .EMIT("_OUT") .EMIT("();") .FLUSH ;
labels := ".LABEL(" .EMIT("  LABEL(") .INT .EMIT("_OUT") "," .EMIT("_OUT")
          .INT .EMIT("_OUT") ")" .EMIT("_OUT") .EMIT(";") .FLUSH ;

 
// SEMANTIC SECTION

SEM1 := .EMIT("Procedure.i ") .EMIT("_OUT") .EMIT("()") .FLUSH .EMIT("  Protected  perr.i = 0") .FLUSH ;
SEM2 := .EMIT("  IF perr < 0  GOTO ") .LABEL(#DOESNEW, #DOESOUT) .EMIT(" EndIf") .FLUSH 
        .LABEL(#DOESPREVIOUS, #DOESSAVE) .STACK("#FROMSAVE") ;
SEM3 := .EMIT("  IF perr > 0  GOTO ") .PEEP() .EMIT("_OUT") .EMIT(";") .FLUSH ;
SEM4 := .EMIT("  ProcedureReturn perr ") .FLUSH EMIT("EndProcedure") .FLUSH .FLUSH ;
SEM5 := .EMIT("  IF perr < 0  GOTO ") .PEEP() .EMIT("_OUT") .EMIT(";") .FLUSH ;
SEM6 := .EMIT("  return; ") .FLUSH .POP(0) .EMIT("_OUT") .EMIT(": ;") .FLUSH ;
SEM7 := .POP(0) .EMIT("_OUT") .EMIT(": ") .FLUSH ;
SEM8 := .LABEL(_NEW,_SAVE) .STACK("_SAVE",0) ;
SEM9 := .EMIT("  ") .EMIT("_OUT") .EMIT("();") .FLUSH ;
SEM10 := .EMIT("  TESTTOKEN(") .EMIT("_OUT") .EMIT(");") .FLUSH ;
SEM12 := .EMIT("_OUT") .EMIT(";") .FLUSH ;
SEM13 := .EMIT("_OUT") ;
SEM14 :=.LABEL(_NEW,_OUT) .EMIT(": ;") .FLUSH .LABEL(_PREVIOUS,_SAVE) .STACK("_SAVE",0)
        .EMIT("  if(!Token.ParseFlag) goto ") .LABEL(_NEW,_OUT) .EMIT(";")
        .FLUSH .LABEL(_PREVIOUS,_SAVE) .STACK("_SAVE",0) ;
SEM15 :=
     .POP(0) .EMIT("_OUT") .EMIT(": ").EMIT("goto ") .POP(0) .SAVETEMP("_TOKEN")
     .POP(0) .EMIT("_OUT") .EMIT(";") .FLUSH .STACK("_SAVE",0)
     .POP(0) .EMIT("_OUT") .EMIT(": ;") .FLUSH
     .EMIT("  Token.ParseFlag = 1;") .FLUSH ;
SEM16 :=
     .POP(0) .EMIT("_OUT") .EMIT(": ")
     .EMIT("if(ScanMode.Mode == 10) Token.ParseFlag = 0;") .FLUSH
     .EMIT("TmpToken.ParseFlag = Token.ParseFlag;") .FLUSH
     .EMIT("ScanMode.Mode = 0;") .FLUSH
     .EMIT("memcpy(&IOs, &TmpFiles, sizeof(IOs));") .FLUSH
     .EMIT("memcpy(&Token, &TmpToken, sizeof(Token));") .FLUSH
     .EMIT("fseek(IOs.CurrentFile,IOs.InFilePosition,SEEK_SET);") .FLUSH
     .EMIT("if(Token.ParseFlag == 0) return;") .FLUSH .FLUSH ;
SEM17 := .EMIT("  ") .EMIT("_OUT") .EMIT("(") ;
SEM18 := .EMIT("  FLUSH();") .FLUSH ;
SEM19 := .EMIT("  ID();") .FLUSH ;
SEM20 := .EMIT("  INT();") .FLUSH ;
SEM21 := .EMIT("  GETSTRING();") .FLUSH ;
SEM23 := .LABEL(_NEW,_SAVE) .STACK("_SAVE",0) ;
SEM25 := .EMIT("  LABEL(") .ID .EMIT("_OUT") "," .EMIT("_OUT") .ID .EMIT("_OUT") ")"
         .EMIT("_OUT") .EMIT(");") .FLUSH ;
SEM27 := .EMIT("Token.ParseFlag = 1;") .FLUSH
         .POP(0) .EMIT("_OUT") .EMIT(": ") .FLUSH ;
SEM28 := .EMIT("SCANFILES TmpFiles;") .FLUSH .EMIT("TOKEN     TmpToken;")
     .FLUSH .EMIT("         i.i = 0;") .FLUSH .FLUSH
     .EMIT("IOs.InFilePosition = ftell(IOs.CurrentFile);") .FLUSH
     .EMIT("ScanMode.Mode = 1;") .FLUSH
     .EMIT("memcpy(&TmpFiles, &IOs, sizeof(IOs));") .FLUSH
     .EMIT("memcpy(&TmpToken, &Token, sizeof(Token));") .FLUSH .FLUSH ;
SEM30 := .EMIT("char ") .STACK("_TOKEN",1) .PEEP(1) .EMIT("_OUT") .EMIT("[MAXTOKENLENGTH];")
                    .FLUSH .EMIT("strcpy(") .POP(1) .EMIT("_OUT") .EMIT(",Token.Token);") .FLUSH ;
SEM35 := .EMIT("  Token.ParseFlag = 1;") .FLUSH ;

#END
Last edited by startup on Wed Oct 14, 2015 8:53 pm, edited 3 times in total.
Top
startup
Enthusiast
Enthusiast
Posts: 105
Joined: Wed Feb 25, 2015 5:55 pm

Re: meta pi compiler compiler

Post by startup »

compiler

Code: Select all

XIncludeFile "modul_scanner.pbi"

EnableExplicit
UseModule meta_scanner



Declare.i elem()
Declare.i entry()
Declare.i stmt()
Declare.i prog()
Declare.i elem2()
Declare.i typ1()
Declare.i typ2() 
Declare.i expr()
Declare.i elemxp()
Declare.i entry2()
Declare.i too()
Declare.i zero()
Declare.i codes()
Declare.i getcode()
Declare.i recurs()
Declare.i look()
Declare.i errtext()
Declare.i nexts()
Declare.i prim()
Declare.i snm()
Declare.i labels()
Declare.i SEM1()
Declare.i SEM_a1()
Declare.i SEM_b1()
Declare.i SEM2()
Declare.i SEM3()
Declare.i SEM4()
Declare.i SEM5()
Declare.i SEM6()
Declare.i SEM7()
Declare.i SEM8()
Declare.i SEM9()
Declare.i SEM10()
Declare.i SEM11()
Declare.i SEM12()
Declare.i SEM13()
Declare.i SEM14()
Declare.i SEM15()
Declare.i SEM16()
Declare.i SEM17()
Declare.i SEM17a()
Declare.i SEM18()
Declare.i SEM19()
Declare.i SEM20()
Declare.i SEM21()
Declare.i SEM22()
Declare.i SEM22a()
Declare.i SEM23()
Declare.i SEM25()
Declare.i SEM26()
Declare.i SEM27()
Declare.i SEM30()
Declare.i EMPTY()

Global prototypestring.s = ""

Procedure.i prog()
  Protected  perr.i
  PrintN("MetaPi Compiler @RKO 2015")
  EMIT("; Created with: MetaPi Compiler @RKO 2015")
  FLUSH()
  FLUSH()
  EMIT("XIncludeFile "+Chr(34)+"modul_scanner.pbi"+Chr(34))
  FLUSH()
  EMIT(" UseModule  meta_scanner")
  FLUSH()
  EMIT("XIncludeFile "+Chr(34)+meta_scanner::protoypeFile + "_inc.pbi"+Chr(34))
  FLUSH()
  FLUSH()
  metapi0:  
perr = stmt()
  If perr < 0 
    ProcedureReturn perr
  EndIf
 metapi1:
  perr = stmt()
  If perr < 0  
    Goto metapi2
  EndIf
  Goto metapi0
 metapi2:
  perr = TESTTOKEN("#END")
  If perr < 0  ;;;;; some error handling
    WriteStringN(scanner\fileoutputchannel,"Error: in line " + Str(scanner\linecount))
    WriteStringN(scanner\fileoutputchannel,scanner\org_line)
    WriteStringN(scanner\fileoutputchannel,Space((Len(scanner\org_line) - Len(scanner\line_s)))+"^")
    PrintN("Error: in line " + Str(scanner\linecount))
    PrintN(scanner\org_line)
    PrintN(Space((Len(scanner\org_line) - Len(scanner\line_s)))+"^")
    ;Goto metapi1
  EndIf
  PrintN("Done compiling " + Str(scanner\linecount) + " lines of BNF")
  ProcedureReturn perr
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i pointerheader()
  Protected perr.i = 0
  perr = TESTTOKEN("*")
  If perr < 0
    Goto new1
  EndIf
  SEM_a1()
  perr = GETANID()
  If perr < 0
    Goto new1
  EndIf
  SEM_a1()
  perr = TESTTOKEN(".")
  If perr < 0
    Goto new1
  EndIf
  SEM_a1()
  perr = TESTTOKEN("integer")
  If perr < 0
    Goto new3
  EndIf
new3: 
  If perr > 0
    Goto new2
  EndIf
  perr = TESTTOKEN("string")
  If perr < 0
    Goto new4
  EndIf
new4: 
  If perr > 0
    Goto new2
  EndIf
  perr = TESTTOKEN("double")
  If perr < 0
    Goto new5
  EndIf
new5: 
  If perr > 0
    Goto new2
  EndIf
  perr = TESTTOKEN("Float")
  If perr < 0
    Goto new6
  EndIf
new6: 
  If perr > 0
    Goto new2
  EndIf
  perr = TESTTOKEN("Quad")
  If perr < 0
    Goto new7
  EndIf
new7: 
  If perr > 0
    Goto new2
  EndIf
  perr = TESTTOKEN("Unicode")
  If perr < 0
    Goto new8
  EndIf
new8: 
  If perr > 0
    Goto new2
  EndIf
  perr = TESTTOKEN("Character")
  If perr < 0
    Goto new9
  EndIf
new9: 
  If perr > 0
    Goto new2
  EndIf
  perr = TESTTOKEN("byte")
  If perr < 0
    Goto new10
  EndIf
new10: 
  If perr > 0
    Goto new2
  EndIf
  perr = TESTTOKEN("Ascii")
  If perr < 0
    Goto new11
  EndIf
new11: 
  If perr > 0
    Goto new2
  EndIf
  perr = GETANID()
  If perr < 0
    Goto new12
  EndIf
new12: 
new2: 
  If perr < 0
    Goto new1
  EndIf
  SEM_a1()
new13:
  If perr < 0
    Goto new14
  EndIf
  perr = TESTTOKEN(",")
  If perr < 0
    Goto new16
  EndIf
  SEM_a1()
  perr = TESTTOKEN("*")
  If perr < 0
    Goto new16
  EndIf
  SEM_a1()
  perr = GETANID()
  If perr < 0
    Goto new16
  EndIf
  SEM_a1()
  perr = TESTTOKEN(".")
  If perr < 0
    Goto new16
  EndIf
  SEM_a1()
  perr = TESTTOKEN("integer")
  If perr < 0
    Goto new18
  EndIf
new18: 
  If perr > 0
    Goto new17
  EndIf
  perr = TESTTOKEN("string")
  If perr < 0
    Goto new19
  EndIf
new19: 
  If perr > 0
    Goto new17
  EndIf
  perr = TESTTOKEN("double")
  If perr < 0
    Goto new20
  EndIf
new20: 
  If perr > 0
    Goto new17
  EndIf
  perr = TESTTOKEN("Float")
  If perr < 0
    Goto new21
  EndIf
new21: 
  If perr > 0
    Goto new17
  EndIf
  perr = TESTTOKEN("Quad")
  If perr < 0
    Goto new22
  EndIf
new22: 
  If perr > 0
    Goto new17
  EndIf
  perr = TESTTOKEN("Unicode")
  If perr < 0
    Goto new23
  EndIf
new23: 
  If perr > 0
    Goto new17
  EndIf
  perr = TESTTOKEN("Character")
  If perr < 0
    Goto new24
  EndIf
new24: 
  If perr > 0
    Goto new17
  EndIf
  perr = TESTTOKEN("byte")
  If perr < 0
    Goto new25
  EndIf
new25: 
  If perr > 0
    Goto new17
  EndIf
  perr = TESTTOKEN("Ascii")
  If perr < 0
    Goto new26
  EndIf
new26: 
  If perr > 0
    Goto new17
  EndIf
  perr = GETANID()
  If perr < 0
    Goto new27
  EndIf
new27: 
new17: 
  If perr < 0
    Goto new16
  EndIf
  SEM_a1()
new16: 
new15: 
  If perr < 0
    Goto new28
  EndIf
new28: 
  Goto new13
new14:
  perr = 1
  ProcedureReturn perr 
new1:
  ProcedureReturn perr 
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i regularheader()
  Protected perr.i = 0
  perr = GETANID()
  If perr < 0
    Goto new29
  EndIf
  SEM_a1()
  perr = TESTTOKEN(".")
  If perr < 0
    Goto new29
  EndIf
  SEM_a1()
  perr = TESTTOKEN("i")
  If perr < 0
    Goto new31
  EndIf
new31: 
  If perr > 0
    Goto new30
  EndIf
  perr = TESTTOKEN("s")
  If perr < 0
    Goto new32
  EndIf
new32: 
  If perr > 0
    Goto new30
  EndIf
  perr = TESTTOKEN("d")
  If perr < 0
    Goto new33
  EndIf
new33: 
  If perr > 0
    Goto new30
  EndIf
  perr = TESTTOKEN("f")
  If perr < 0
    Goto new34
  EndIf
new34: 
  If perr > 0
    Goto new30
  EndIf
  perr = TESTTOKEN("q")
  If perr < 0
    Goto new35
  EndIf
new35: 
  If perr > 0
    Goto new30
  EndIf
  perr = TESTTOKEN("u")
  If perr < 0
    Goto new36
  EndIf
new36: 
  If perr > 0
    Goto new30
  EndIf
  perr = TESTTOKEN("c")
  If perr < 0
    Goto new37
  EndIf
new37: 
  If perr > 0
    Goto new30
  EndIf
  perr = TESTTOKEN("b")
  If perr < 0
    Goto new38
  EndIf
new38: 
  If perr > 0
    Goto new30
  EndIf
  perr = TESTTOKEN("a")
  If perr < 0
    Goto new39
  EndIf
new39: 
new30: 
  If perr < 0
    Goto new29
  EndIf
  SEM_a1()
new40:
  If perr < 0
    Goto new41
  EndIf
  perr = TESTTOKEN(",")
  If perr < 0
    Goto new43
  EndIf
  SEM_a1()
  perr = GETANID()
  If perr < 0
    Goto new43
  EndIf
  SEM_a1()
  perr = TESTTOKEN(".")
  If perr < 0
    Goto new43
  EndIf
  SEM_a1()
  perr = TESTTOKEN("i")
  If perr < 0
    Goto new45
  EndIf
new45: 
  If perr > 0
    Goto new44
  EndIf
  perr = TESTTOKEN("s")
  If perr < 0
    Goto new46
  EndIf
new46: 
  If perr > 0
    Goto new44
  EndIf
  perr = TESTTOKEN("d")
  If perr < 0
    Goto new47
  EndIf
new47: 
  If perr > 0
    Goto new44
  EndIf
  perr = TESTTOKEN("f")
  If perr < 0
    Goto new48
  EndIf
new48: 
  If perr > 0
    Goto new44
  EndIf
  perr = TESTTOKEN("q")
  If perr < 0
    Goto new49
  EndIf
new49: 
  If perr > 0
    Goto new44
  EndIf
  perr = TESTTOKEN("u")
  If perr < 0
    Goto new50
  EndIf
new50: 
  If perr > 0
    Goto new44
  EndIf
  perr = TESTTOKEN("c")
  If perr < 0
    Goto new51
  EndIf
new51: 
  If perr > 0
    Goto new44
  EndIf
  perr = TESTTOKEN("b")
  If perr < 0
    Goto new52
  EndIf
new52: 
  If perr > 0
    Goto new44
  EndIf
  perr = TESTTOKEN("a")
  If perr < 0
    Goto new53
  EndIf
new53: 
new44: 
  If perr < 0
    Goto new43
  EndIf
  SEM_a1()
new43: 
new42: 
  If perr < 0
    Goto new54
  EndIf
new54: 
  Goto new40
new41:
  perr = 1
  ProcedureReturn perr 
new29:
  ProcedureReturn perr 
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i stmt()
  Protected perr.i = 0
  perr = GETANID()
  If perr < 0
    Goto new55
  EndIf
  SEM_a1()
  perr = TESTTOKEN("(")
  If perr < 0
    Goto new57
  EndIf
  SEM_a1()
  perr = pointerheader()
  If perr < 0
    Goto new59
  EndIf
new59: 
  If perr > 0
    Goto new58
  EndIf
  perr = regularheader()
  If perr < 0
    Goto new60
  EndIf
new60: 
new58: 
  If perr < 0
    Goto new57
  EndIf
new61:
  If perr < 0
    Goto new62
  EndIf
  perr = pointerheader()
  If perr < 0
    Goto new64
  EndIf
new64: 
  If perr > 0
    Goto new63
  EndIf
  perr = regularheader()
  If perr < 0
    Goto new65
  EndIf
new65: 
new63: 
  If perr < 0
    Goto new66
  EndIf
new66: 
  Goto new61
new62:
  perr = 1
  perr = TESTTOKEN(")")
  If perr < 0
    Goto new57
  EndIf
  SEM_a1()
  SEM_b1()
new57: 
  If perr > 0
    Goto new56
  EndIf
  SEM1()
  perr = 1
new67: 
new56: 
  If perr < 0
    Goto new55
  EndIf
  perr = TESTTOKEN(":=")
  If perr < 0
    Goto new55
  EndIf
  perr = entry()
  If perr < 0
    Goto new55
  EndIf
new68:
  If perr < 0
    Goto new69
  EndIf
  perr = TESTTOKEN("|")
  If perr < 0
    Goto new71
  EndIf
  perr = entry()
  If perr < 0
    Goto new71
  EndIf
new71: 
new70: 
  If perr < 0
    Goto new72
  EndIf
new72: 
  Goto new68
new69:
  perr = 1
  SEM4()
  SYNCTO(";");
  perr = TESTTOKEN(";")
  If perr < 0
    Goto new55
  EndIf
  ProcedureReturn perr 
new55:
  ProcedureReturn perr 
EndProcedure

Procedure.i entry()
  Protected  perr.i
  perr = elem()
  If perr < 0  
    ProcedureReturn perr 
  EndIf
 MetaPi11:
 If perr < 0  
   Goto MetaPi12
  EndIf
  perr = elem2()
  Goto MetaPi11
 MetaPi12:
  perr = 1
  SEM6()
  ProcedureReturn perr
EndProcedure

Procedure.i elem()
  Protected  perr.i
  perr = typ1()
  If perr < 0
   Goto MetaPi14
  EndIf
  perr = SEM8()
  ProcedureReturn perr
  MetaPi14:
  perr = typ2()
  If perr < 0
   Goto MetaPi15
  EndIf
  perr = SEM2()
  ProcedureReturn perr
  MetaPi15:
  perr = prim()
  If perr < 0 
    ProcedureReturn perr
   EndIf
  SEM8()
  ProcedureReturn perr
EndProcedure

Procedure.i elem2()
  Protected  perr.i
  perr = typ1()
  If perr < 0
   Goto MetaPi17
  EndIf
  ProcedureReturn perr
  MetaPi17:
  perr = typ2()
  If perr < 0
   Goto MetaPi18
  EndIf
  SEM5()
  ProcedureReturn 0
  MetaPi18:
  perr = prim()
  ProcedureReturn perr
EndProcedure

Procedure.i typ1()
  Protected  perr.i
  perr = codes()
  If perr < 0
   Goto NEW22
  EndIf
  ProcedureReturn perr
  NEW22:
  perr = too()
  If perr < 0
   Goto NEW23
  EndIf
  ProcedureReturn perr
  NEW23:
  perr = recurs()
  If perr < 0
   Goto NEW24
  EndIf
  ProcedureReturn perr
  NEW24:
  perr = getcode()
  If perr < 0
   Goto NEW25
  EndIf
  ProcedureReturn perr
  NEW25:
  perr = NEXTs()
  If perr < 0
   Goto NEW26
  EndIf
  ProcedureReturn perr
  NEW26:
  perr = snm()
  If perr < 0
   Goto NEW27
  EndIf
  ProcedureReturn perr
  NEW27:
  perr = labels()
  If perr < 0
   Goto NEW28
  EndIf
  ProcedureReturn perr
  NEW28:
  perr = look()
  If perr < 0
   Goto NEW29
  EndIf
  ProcedureReturn perr
  NEW29:
  perr = zero()
  If perr < 0
   Goto NEW30
  EndIf
  ProcedureReturn perr
  NEW30:
  ProcedureReturn perr
EndProcedure

Procedure.i typ2() 
  Protected  perr.i
  perr = expr()
  If perr < 0
    Goto NEWS28
  EndIf
  ProcedureReturn perr
  NEWS28:
  perr = GETANID()
  If perr < 0
    Goto NEWS29
  EndIf
  SEM10()
  ProcedureReturn perr
  NEWS29:
  perr = GETSTRING()
  If perr < 0
    Goto NEWS30
  EndIf
  SEM11()
  ProcedureReturn perr
  NEWS30:
  perr = TESTTOKEN(".ID")
  If perr < 0
    Goto NEWS31
  EndIf
  SEM20()
  perr = TESTTOKEN(":")
  If perr < 0
    Goto NEWS33
  EndIf
  perr = GETANID()
  If perr < 0
    Goto NEWS33
  EndIf
  SEM30()
  NEWS33:
  If perr > 0  
    Goto NEWS32
  EndIf
  perr = 1
  NEWS32:
  If perr < 0
     Goto NEWS31
  EndIf
  POPSTACK(3) 
  ProcedureReturn perr
  NEWS31:
  perr = TESTTOKEN(".INT")
  If perr < 0
     Goto NEWS35
  EndIf
  SEM21()
  perr = TESTTOKEN(":")
  If perr < 0
     Goto NEWS37
  EndIf
  perr = GETANID()
  If perr < 0
     Goto NEWS37
  EndIf
  SEM30()
  NEWS37:
  If perr > 0  
    Goto NEWS36
  EndIf
  perr = 1
  NEWS36:
  If perr < 0
     Goto NEWS35
  EndIf
  POPSTACK(3) 
  ProcedureReturn perr
  NEWS35:
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  perr = TESTTOKEN(".REAL")
  If perr < 0
     Goto NEWS391
  EndIf
  SEM22a()
  perr = TESTTOKEN(":")
  If perr < 0
     Goto NEWS411
  EndIf
  perr = GETANID()
  If perr < 0
     Goto NEWS411
  EndIf
  SEM30()
  NEWS411:
  ProcedureReturn perr
  NEWS391:
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  perr = TESTTOKEN(".GETSTRING")
  If perr < 0
     Goto NEWS39
  EndIf
  SEM22()
  perr = TESTTOKEN(":")
  If perr < 0
     Goto NEWS41
  EndIf
  perr = GETANID()
  If perr < 0
     Goto NEWS41
  EndIf
  SEM30()
  NEWS41:
  If perr > 0  
    Goto NEWS40
  EndIf
  perr = 1
  NEWS40:
  If perr < 0
     Goto NEWS39
  EndIf
  POPSTACK(3) 
  ProcedureReturn perr
  NEWS39:
  perr = TESTTOKEN(".LABEL(")
  If perr < 0
     Goto NEWS43
  EndIf
  SEM25()
  ProcedureReturn perr
  NEWS43:
  ProcedureReturn perr
EndProcedure

Procedure.i expr()
  Protected  perr.i
  perr = TESTTOKEN("(")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  SEM23()
  perr = elemxp()
  If perr < 0 
    ProcedureReturn perr
  EndIf
  perr = TESTTOKEN(")")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  SEM7()
EndProcedure

Procedure.i elemxp()
  Protected  perr.i
  perr = entry2()
  If perr < 0 
    ProcedureReturn perr
  EndIf
  MetaPi35:
  If perr < 0
    Goto  MetaPi36
  EndIf
  perr = TESTTOKEN("|")
  If perr < 0
    Goto  MetaPi39
  EndIf
  SEM3()
  perr = entry2()
  MetaPi39:
   Goto MetaPi35
  MetaPi36:
  perr = 1
  ProcedureReturn perr
EndProcedure

Procedure.i entry2()
  Protected  perr.i
  perr = elem()
  If perr < 0 
    ProcedureReturn perr
  EndIf
  MetaPi41:
  If perr < 0
    Goto  MetaPi42
  EndIf
  perr = elem2()
  Goto MetaPi41
  MetaPi42:
  perr = 1
  SEM7()
  ProcedureReturn perr
EndProcedure

Procedure.i too()
  Protected  perr.i
  perr = TESTTOKEN(".SYNC2")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  perr = TESTTOKEN("(")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  perr = GETSTRING()
  EMIT("  SYNCTO(")
  EMIT("", #FROMOUT)
  EMIT(");")
  perr = TESTTOKEN(")")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i zero()
  Protected  perr.i
  perr = TESTTOKEN("{")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  SEM23()
  perr = elemxp()
  If perr < 0
    Goto  NEWS54
  EndIf
  NEWS54:
  If perr > 0  
    Goto  NEWS53
  EndIf
  perr = 1
  NEWS53:
  perr = TESTTOKEN("}")
  If perr < 0
    Goto  NEWS52
  EndIf
  SEM27()
  ProcedureReturn perr
  NEWS52:
  ProcedureReturn perr
EndProcedure

Procedure.i codes()
  Protected  perr.i
  perr = TESTTOKEN("@@")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  FLUSH()
  EMIT("; START OF USER CODE")
  FLUSH()
  perr = DOCODES("@@")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  EMIT("; END   OF USER CODE")
  FLUSH()
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i getcode()
  Protected  perr.i
  perr = TESTTOKEN(".COLLECT2")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  perr = TESTTOKEN("(")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  perr = GETSTRING()
  EMIT("  COLLECTTO(")
  EMIT("", #FROMOUT)
  perr = TESTTOKEN(")")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  EMIT(");")
  FLUSH()
  EMIT("  if perr < 0")
  FLUSH()
  EMIT("    ProcedureReturn perr")
  FLUSH()
  EMIT("  endif")
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i recurs()
  Protected  perr.i
  perr = TESTTOKEN("$")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  SEM14()
  perr = elem()
  If perr < 0 
    ProcedureReturn perr
  EndIf
  SEM15()
  ProcedureReturn perr
EndProcedure

Procedure.i look()
  Protected  perr.i
  perr = TESTTOKEN("?")
  If perr < 0
    Goto  NEWS49
  EndIf
  SEM26()
  perr = elem()
  If perr < 0
    Goto NEWS49
  EndIf
  SEM16()
  ProcedureReturn perr
  NEWS49:
  ProcedureReturn perr
EndProcedure

Procedure.i lookzero()
  Protected  perr.i
  perr = TESTTOKEN("?[")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  SEM26()
  SEM23()
  perr = elemxp()
  If perr < 0
    Goto  NEWS54
  EndIf
  NEWS54:
  If perr > 0  
    Goto  NEWS53
  EndIf
  perr = 1
  NEWS53:
  perr = TESTTOKEN("]")
  If perr < 0
    Goto  NEWS52
  EndIf
  SEM16()
  SEM27()
  ProcedureReturn perr
  NEWS52:
  SEM16()
  ProcedureReturn perr
EndProcedure

Procedure.i errtext()
  Protected  perr.i
  perr = TESTTOKEN("<<")
  If perr < 0
    Goto  NEWSs49
  EndIf
  perr = GETSTRING()
  If perr < 0
    Goto NEWSs49
  EndIf
  SEM9()
  perr = TESTTOKEN(",")
  If perr < 0
    Goto NEWSs48
  EndIf
  perr = GETSTRING()
  SEM19()
  If perr < 0
    Goto NEWSs49
  EndIf
  NEWSs48:
  perr = TESTTOKEN(">>")
  ProcedureReturn perr
  NEWSs49:
  ProcedureReturn perr
EndProcedure

Procedure.i nexts()
  Protected  perr.i
  perr = TESTTOKEN(".FLUSH")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  SEM18()
  ProcedureReturn 1
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i callheader()
  Protected perr.i = 0
  perr = TESTTOKEN("@")
  If perr < 0
    Goto prim74
  EndIf
  SEM13()
prim74: 
  perr = 1
prim73:
  perr = GETANID()
  If perr < 0
    Goto prim77
  EndIf
prim77: 
  If perr > 0
    Goto prim76
  EndIf
  perr = GETINT()
  If perr < 0
    Goto prim78
  EndIf
prim78: 
  If perr > 0
    Goto prim76
  EndIf
  perr = GETSTRING()
  If perr < 0
    Goto prim79
  EndIf
prim79: 
prim76: 
  If perr < 0
    Goto prim75
  EndIf
  SEM13()
prim80:
  If perr < 0
    Goto prim81
  EndIf
  perr = TESTTOKEN(",")
  If perr < 0
    Goto prim83
  EndIf
  perr = TESTTOKEN("@")
  If perr < 0
    Goto prim85
  EndIf
  SEM13()
prim85: 
  perr = 1
prim84:
  SEM13()
  perr = GETANID()
  If perr < 0
    Goto prim87
  EndIf
prim87: 
  If perr > 0
    Goto prim86
  EndIf
  perr = GETINT()
  If perr < 0
    Goto prim88
  EndIf
prim88: 
  If perr > 0
    Goto prim86
  EndIf
  perr = GETSTRING()
  If perr < 0
    Goto prim89
  EndIf
prim89: 
prim86: 
  If perr < 0
    Goto prim83
  EndIf
  SEM13()
prim83: 
prim82: 
  If perr < 0
    Goto prim90
  EndIf
prim90: 
  Goto prim80
prim81:
  perr = 1
  ProcedureReturn perr 
prim75:
  ProcedureReturn perr 
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i prim()
  Protected perr.i = 0
  perr = TESTTOKEN(".")
  If perr < 0
    Goto prim91
  EndIf
  perr = GETANID()
  If perr < 0
    Goto prim91
  EndIf
  SEM17()
  perr = TESTTOKEN("(")
  If perr < 0
    Goto prim93
  EndIf
  SEM13()
  perr = callheader()
  If perr < 0
    Goto prim93
  EndIf
prim94:
  If perr < 0
    Goto prim95
  EndIf
  perr = TESTTOKEN(",")
  If perr < 0
    Goto prim97
  EndIf
  SEM13()
  perr = callheader()
  If perr < 0
    Goto prim97
  EndIf
prim97: 
prim96: 
  If perr < 0
    Goto prim98
  EndIf
prim98: 
  Goto prim94
prim95:
  perr = 1
  perr = TESTTOKEN(")")
  If perr < 0
    Goto prim93
  EndIf
  SEM12()
prim93: 
  If perr > 0
    Goto prim92
  EndIf
  perr = 1
prim92: 
  If perr < 0
    Goto prim91
  EndIf
  ProcedureReturn perr 
prim91:
  ProcedureReturn perr 
EndProcedure

Procedure.i snm()
  Protected  perr.i
  perr = TESTTOKEN("SEM")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  EMIT("  ")
  EMIT("",#FROMOUT)
  perr = GETINT()
  If perr > 0  
    Goto  NEWS87
  EndIf
  perr = TESTTOKEN("_")
  If perr < 0  
    Goto  NEWS87
  EndIf
  EMIT("",#FROMOUT)
  perr = GETANID()
  NEWS87:
  If perr < 0 
    ProcedureReturn perr
  EndIf
  EMIT("",#FROMOUT)
  EMIT("()")
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i labels()
  Protected  perr.i
  perr = TESTTOKEN(".LABEL(")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  EMIT("  LABEL(")
  perr = GETANID()
  EMIT("", #FROMOUT)
  perr = TESTTOKEN(",")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  EMIT(",")
  perr = GETANID()
  EMIT("", #FROMOUT)
  perr = TESTTOKEN(")")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  EMIT(")")
  FLUSH()
  ProcedureReturn perr
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Procedure.i SEM1()
  Protected  perr.i = 0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM1")
  EndIf
  EMIT(";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")
  FLUSH()
  EMIT("Procedure.i ")
  EMIT("", #FROMOUT)
  meta_scanner::prototypes(scanner\token\token) = scanner\token\token + "()"
  EMIT("()")
  FLUSH()
  EMIT("  Protected perr.i = 0")
  ;FLUSH()
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM1")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM_a1()
  Protected  perr.i = 0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM1")
  EndIf
  prototypestring = prototypestring + scanner\token\token
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM1")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM_b1()
  Protected  perr.i = 0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM1")
  EndIf
  EMIT(";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")
  FLUSH()
  meta_scanner::prototypes(prototypestring) = prototypestring
  EMIT("Procedure.i ")
  EMIT(prototypestring)
  FLUSH()
  EMIT("  Protected perr.i = 0")
  FLUSH()
  prototypestring = ""
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM1")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM2()
  Protected  perr.i = 0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM2")
  EndIf
  EMIT("  IF perr < 0")
  FLUSH()
  EMIT("    GOTO ")
  DOLABEL(#DOESNEW, #DOESOUT)
  FLUSH()
  EMIT("  EndIf")
  FLUSH()
  DOLABEL(#DOESPREVIOUS, #DOESSAVE)
  STACKS(#FROMSAVE)
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM2")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM3()
  Protected  perr.i = 0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM3")
  EndIf
  EMIT("  IF perr > 0")
  FLUSH()
  EMIT("    Goto ")
  PEEPSTACK()
  EMIT("", #FROMOUT)
  FLUSH()
  EMIT("  EndIf")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM3")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM4()
  Protected  perr.i = 0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM4")
  EndIf
  prototypestring = "" 
  EMIT("  ProcedureReturn perr ")
  FLUSH()
  EMIT("EndProcedure")
  FLUSH()
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM4")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM5()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM5")
  EndIf
  EMIT("  IF perr < 0")
  FLUSH()
  EMIT("    GOTO ")
  PEEPSTACK()
  EMIT("", #FROMOUT)
  FLUSH()
  EMIT("  EndIf"); , #FROMOUT)
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM5")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM6()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM6")
  EndIf
  EMIT("  ProcedureReturn perr ")
  FLUSH()
  POPSTACK()
  EMIT("", #FROMOUT)
  EMIT(":")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM6")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM7()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM7")
  EndIf
  POPSTACK()
  EMIT("", #FROMOUT)
  EMIT(": ")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM7")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM8()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM8")
  EndIf
  DOLABEL(#DOESNEW, #DOESSAVE)
  STACKS(#FROMSAVE)
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM8")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM9()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM9")
  EndIf
  EMIT("  ErrorText = ")
  EMIT("", #FROMOUT)
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM9")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM10()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM10")
  EndIf
  EMIT("  perr = ")
  EMIT("", #FROMOUT)
  EMIT("()")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM10")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM11()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM11")
  EndIf
  EMIT("  perr = TESTTOKEN(")
  EMIT("", #FROMOUT)
  EMIT(")")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM11")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM12()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM12")
  EndIf
  EMIT("", #FROMOUT)
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM12")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM13()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM13")
  EndIf
  EMIT("", #FROMOUT)
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM13")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM14()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM14")
  EndIf
  DOLABEL(#DOESNEW, #DOESOUT)
  EMIT(":")
  FLUSH()
  DOLABEL(#DOESPREVIOUS, #DOESSAVE)
  STACKS(#FROMSAVE)
  EMIT("  IF perr < 0")
  FLUSH()
  EMIT("    GOTO ")
  DOLABEL(#DOESNEW, #DOESOUT)
  FLUSH()
  EMIT("  EndIf")
  FLUSH()
  DOLABEL(#DOESPREVIOUS, #DOESSAVE)
  STACKS(#FROMSAVE)
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM14")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM15()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM15")
  EndIf
  POPSTACK()
  EMIT("", #FROMOUT)
  EMIT(": ")
  FLUSH()
  EMIT("  GOTO ")
  POPSTACK()
  SAVETEMP()
  POPSTACK()
  EMIT("", #FROMOUT)
  ;EMIT(":")
  FLUSH()
  STACKS(#FROMSAVE)
  POPSTACK()
  EMIT("", #FROMOUT)
  EMIT(":")
  FLUSH()
  EMIT("  perr = 1")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM15")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM16()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM16")
  EndIf
  FLUSH()
  POPSTACK()
  EMIT("", #FROMOUT)
  EMIT(": ")
  FLUSH()
  EMIT("  CopyScannerStructure(@scanner, @tmpscanner)")
  FLUSH()    
  EMIT("  FileSeek(scanner\currentFile, scanner\fileposition)")
  FLUSH()
  EMIT("  if perr < 0")
  FLUSH()
  EMIT("    ProcedureReturn perr")
  FLUSH()
  EMIT("  endif")
  FLUSH()
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM16")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM17() ;;;; . and ID
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM17")
  EndIf
  EMIT("  perr = ")
  EMIT("", #FROMOUT)
  ;EMIT("(")
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM17")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM17a() ;;;; . and ID
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM17")
  EndIf
  EMIT(")")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM17")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM18()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM18")
  EndIf
  EMIT("  FLUSH()")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM18")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM19()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM19")
  EndIf
  EMIT("  SyncText = ")
  EMIT("", #FROMOUT)
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM19")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM20()
  Protected  perr.i=0
  EMIT("  perr = GETANID()")
  STACKS(#FROMTOKEN, "",#id, 3)
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i SEM21()
  Protected  perr.i=0
  EMIT("  perr = GETINT()")
  STACKS(#FROMTOKEN, "",#integer, 3)
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i SEM22()
  Protected  perr.i=0
  EMIT("  perr = GETSTRING()")
  STACKS(#FROMTOKEN, "",#string, 3)
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i SEM22a()
  Protected  perr.i=0
  EMIT("  perr = GETREAL()")
  STACKS(#FROMTOKEN, "",#float, 3)
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i SEM23()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM23")
  EndIf
  DOLABEL(#DOESNEW, #DOESSAVE)
  STACKS(#FROMSAVE)
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM23")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM25()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM25")
  EndIf
  EMIT("  LABEL(")
  perr = GETANID()
  EMIT("", #FROMOUT)
  perr = TESTTOKEN(",")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  EMIT(",")
  perr = GETANID()
  EMIT("", #FROMOUT)
  perr = TESTTOKEN(")")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  EMIT(")")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM25")
  EndIf
EndProcedure

Procedure.i SEM26()
  Protected  perr.i=0
  EMIT("  CopyScannerStructure(@tmpscanner, @scanner)")
  FLUSH()
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i SEM27()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM27")
  EndIf
  EMIT("  perr = 1")
  FLUSH()
  POPSTACK()
  EMIT("", #FROMOUT)
  EMIT(":")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM27")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM30()
  Protected  perr.i=0
  EMIT("  Protected ")
  STACKS(#FROMTOKEN, "",#none, 1)
  POPSTACK(1)
  EMIT("", #FROMOUT)
  PEEPSTACK(3)
  Select scanner\token\tokentype
    Case #none, #string
      EMIT(".s")
    Case #integer
      EMIT(".i")
    Case #float
      EMIT(".d")
    Case #id
      EMIT(".s")
    Case #anychar
      EMIT(".c")
    Case #code
      EMIT(".s")
    Case #collect
      EMIT(".s")
  EndSelect   
  ;EMIT(".s")
  EMIT(" = ")
  ;  EMIT(" token")
  POPSTACK(3)
  Select scanner\token\tokentype
    Case #none
      EMIT(" scanner\token\token")
    Case #string
      EMIT("chr(34)+") : EMIT("scanner\token\token") : EMIT("+chr(34)")
    Case #integer
      EMIT(" val(scanner\token\token)")
    Case #float
      EMIT(" vald(scanner\token\token)")
    Case #id
      EMIT(" scanner\token\token")
    Case #anychar
      EMIT(" scanner\token\token")
    Case #code
      EMIT(" scanner\token\token")
    Case #collect
      EMIT(" scanner\token\token")
  EndSelect     
  FLUSH()
  ProcedureReturn perr
EndProcedure



Procedure CREATES(in.s, out.s)
  scanner\fileinputchannel  = OpenFile(#PB_Any, in, #PB_File_SharedRead )
  scanner\fileoutputchannel = CreateFile(#PB_Any, out)
  meta_scanner::protoypeFile= out
  scanner\largestColumn     = 0
  scanner\labelnumber       = 0
  scanner\libInProgress     = 0
  scanner\currentFile       = scanner\fileinputchannel
  scanner\mainInputFile     = scanner\fileinputchannel
  scanner\fileposition      = Loc(scanner\fileinputchannel)
  scanner\doingCode         = #False
  scanner\doingTrace        = #False
  scanner\doingToScreen     = #True
  scanner\mainIsSet         = #False
  scanner\LabelName         = "METAPI"
  scanner\DEBUGS            = #False
  scanner\token\tokentype   = #none
  scanner\token\token       = ""
  Protected i.i
  For i = 0 To #MAXSTACKS
    scanner\stackpointer(i) = 0
  Next
  meta_scanner::protoypeFile = GetFilePart(meta_scanner::protoypeFile, #PB_FileSystem_NoExtension)  
EndProcedure



OpenConsole("MetaPi Compiler @RKO")
CREATES("TEST1", "metaout.pbi")
prog()
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
If scanner\mainName <> ""
  meta_scanner::prototypes(scanner\token\token) = scanner\mainName
  WriteStringN(scanner\fileoutputchannel, "")
  WriteStringN(scanner\fileoutputchannel, ";;;;;;;;;;;;; MAIN to call")
  WriteStringN(scanner\fileoutputchannel, scanner\mainName+"()")
EndIf
;CloseFile(scanner\fileoutputchannel)
scanner\fileoutputchannel = CreateFile(#PB_Any, meta_scanner::protoypeFile + "_inc.pbi")
WriteStringN(scanner\fileoutputchannel, "; Created with: MetaPi Compiler @RKO 2015")
WriteStringN(scanner\fileoutputchannel, "")
ResetMap(meta_scanner::prototypes())
While NextMapElement(meta_scanner::prototypes())
  WriteStringN(scanner\fileoutputchannel, "Declare.i " + meta_scanner::prototypes())
Wend
CloseFile(scanner\fileoutputchannel)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
FreeMap(prototypes())
Input()
CloseConsole()
Top
startup
Enthusiast
Enthusiast
Posts: 105
Joined: Wed Feb 25, 2015 5:55 pm

Re: meta pi compiler compiler

Post by startup »

scanner
needs optimizing and loving care

Code: Select all

DeclareModule meta_scanner
  EnableExplicit
  
  #atEOF          = -10000
  #MAXFILELIBRARIES = 10
  #MAXSTACKS      = 10
  #MAXINSTACK     = 1000
  #GETANIDERROR   = 1
  #TESTTOKENERROR = 2
  #GETINTERROR    = 3
  #GETREALERROR   = 4
  #GETSTRINGERROR = 5
  #GETANYCHARERROR= 6
  #SYNCTOERROR    = 7
  #COLLECTTOERROR = 8
  #CODEERROR      = 11
  #DOESSAVE       = 100
  #DOESOUT        = 101
  #DOESPREVIOUS   = 103
  #DOESNEW        = 104
  #FROMSAVE       = 1
  #FROMTOKEN      = 2
  #FROMOUT        = 3
  #FROMSTRING     = 4
  
  NewMap prototypes.s()
  Global protoypeFile.s = ""

  Enumeration toktype
    #none
    #string
    #integer
    #float
    #id
    #anychar
    #code
    #collect
  EndEnumeration
  
  Structure token
    token.s
    tokentype.i
  EndStructure
  
  Structure scan
   columncount.i
   largestColumn.i
   linecount.i
   fileinputchannel.i
   fileoutputchannel.i
   labelnumber.i
   libInProgress.i
   currentFile.i
   mainInputFile.i
   fileposition.q
   doingCode.i
   doingTrace.i
   doingToScreen.i
   mainIsSet.i
   token.token
   SaveString.s
   LabelName.s
   OutString.s
   inFilename.s
   mainName.s
   DEBUGS.i
   line_s.s
   org_line.s
   Array filelibraries.s(#MAXFILELIBRARIES)
   Array stack.token(#MAXSTACKS,#MAXINSTACK)
   Array stackpointer.i(#MAXSTACKS)
  EndStructure
  
  Global scanner.scan, tmpscanner.scan
  
  Declare   ClearScannerStructure(*p.scan)
  Declare   CopyScannerStructure(*out.scan, *in.scan)
  Declare.i IsWhite(char.s)
  Declare.i IsDigit(char.s)
  Declare.i GETANID()
  Declare.i GETINT()
  Declare.i GETREAL()
  Declare.i GETSTRING()
  Declare.i GETANYCHAR()
  Declare.i DOCODES(untils.s)
  Declare.i TESTTOKEN(stoken.s)
  Declare.i COLLECTTO(CollectChars.s)
  Declare.i GETNOT(NotChar.s)
  Declare.i SYNCTO(SyncChar.s)
  Declare   SAVETEMP(SaveStrings.s = "")
  Declare   DOLABEL(lmode.i, generate.i)
  Declare.i STACKS(fromwhat.i, stringvals.s = "", type.i=#none, whichs.i = 0)
  Declare   POPSTACK(whichs.i = 0)
  Declare   PEEKSTACK(element.i, whichs.i=0)
  Declare   PEEPSTACK(whichs.i=0)
  Declare   EMIT(EmitString.s, whichs.i=0)
  Declare   FLUSH()

EndDeclareModule

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Module meta_scanner
  EnableExplicit
  
  Procedure ClearScannerStructure(*p.scan)
    *p\columncount   = 0
    *p\largestColumn = 0
    *p\linecount     = 0
    *p\fileinputchannel  = 0
    *p\fileoutputchannel = 0
    *p\labelnumber   = 0
    *p\libInProgress = 0
    *p\currentFile   = 0
    *p\mainInputFile = 0
    *p\fileposition  = 0
    *p\doingCode     = #False
    *p\doingTrace    = #False
    *p\doingToScreen = #False
    *p\mainIsSet     = #False
    *p\token\token   = ""
    *p\token\tokentype= #none
    *p\SaveString    = ""
    *p\LabelName     = ""
    *p\OutString     = ""
    *p\inFilename    = ""
    *p\mainName      = ""
    *p\DEBUGS        = #False
    *p\line_s        = ""
    FreeArray(*p\filelibraries())
    Dim *p\filelibraries(#MAXFILELIBRARIES)
    FreeArray(*p\stack())
    Dim *p\stack(#MAXSTACKS, #MAXINSTACK)
    FreeArray(*p\stackpointer())
    *p\stackpointer(#MAXSTACKS)
  EndProcedure
  
  Procedure CopyScannerStructure(*out.scan, *in.scan)
    *out\columncount   =      *in\columncount
    *out\largestColumn =      *in\largestColumn
    *out\linecount     =      *in\linecount
    *out\fileinputchannel  =  *in\fileinputchannel
    *out\fileoutputchannel =  *in\fileoutputchannel
    *out\labelnumber   =      *in\labelnumber
    *out\libInProgress =      *in\libInProgress
    *out\currentFile   =      *in\currentFile
    *out\mainInputFile =      *in\mainInputFile
    *out\fileposition  =      *in\fileposition
    *out\doingCode     =      *in\doingCode
    *out\doingTrace    =      *in\doingTrace
    *out\doingToScreen =      *in\doingToScreen
    *out\mainIsSet     =      *in\mainIsSet
    *out\token\token   =      *in\token\token
    *out\token\tokentype=     *in\token\tokentype
    *out\SaveString    =      *in\SaveString
    *out\LabelName     =      *in\LabelName
    *out\OutString     =      *in\OutString
    *out\inFilename    =      *in\inFilename
    *out\mainName      =      *in\mainName
    *out\DEBUGS        =      *in\DEBUGS
    *out\line_s        =      *in\line_s
    CopyArray(*in\filelibraries(), *out\filelibraries())
    CopyArray(*in\stack(), *out\stack())
    CopyArray(*in\stackpointer(), *out\stackpointer())
  EndProcedure
  
  Procedure.i IsWhite(char.s)
    Select Asc(char)
      Case 32, 0
        ProcedureReturn #True     
      Default
        ProcedureReturn #False
    EndSelect
  EndProcedure
   
  Procedure.i IsDigit(char.s)
    Select Asc(char)
      Case 48 To 57, 46
        ProcedureReturn #True     
      Default
        ProcedureReturn #False
    EndSelect
  EndProcedure
  
  Procedure.i READLINE()
    scanner\line_s = Trim(ReadString(scanner\currentFile))
    scanner\fileposition = Loc(scanner\currentFile)
    scanner\linecount + 1
    scanner\columncount = 1
    scanner\org_line = scanner\line_s
    If scanner\line_s <> "" 
      scanner\columncount = Len(scanner\line_s)
      ProcedureReturn scanner\largestColumn
    Else
      If Eof(scanner\currentFile) 
        scanner\columncount = Len(scanner\line_s)
        ProcedureReturn #atEOF
      EndIf
      scanner\columncount = Len(scanner\line_s)
      ProcedureReturn -1
    EndIf
    scanner\columncount = Len(scanner\line_s)
    ProcedureReturn -1
  EndProcedure
  
  Procedure.i READCARD()
    READCARD1:
    If READLINE() = #atEOF 
      If scanner\libInProgress > 0 
        PrintN("++++++++++ END PARSING LIB " + scanner\filelibraries(scanner\libInProgress))
        CloseFile(scanner\libInProgress)
        scanner\libInProgress - 1
        If scanner\libInProgress = 0 
          scanner\currentFile = scanner\mainInputFile
          scanner\libInProgress = 0
        EndIf
        Goto READCARD1
      Else
        ProcedureReturn #atEOF
      EndIf
    EndIf
    ;Print line_s
    If scanner\doingCode = #False 
      If Left(scanner\line_s, 1) = "#" 
        If Left(scanner\line_s, 4) = "#END" 
          If scanner\libInProgress > 0 
            PrintN("++++++++++ END PARSING LIB " + scanner\filelibraries(scanner\libInProgress))
            CloseFile(scanner\libInProgress)
            scanner\libInProgress - 1
            If scanner\libInProgress = 0 
              scanner\currentFile = scanner\mainInputFile
              scanner\libInProgress = 0
            EndIf
            Goto READCARD1
          Else
            ProcedureReturn #atEOF
          EndIf
          Goto READCARD1
        EndIf
        If Left(scanner\line_s, 5) = "#FILE" 
          If scanner\doingToScreen = #True 
            PrintN("LINE: " +Str(scanner\linecount))
            PrintN(scanner\line_s)
          EndIf
          scanner\line_s = Mid(scanner\line_s, 6,Len(scanner\line_s)) 
          If GETANID() > 0 
            CloseFile(scanner\currentFile)
            scanner\currentFile =  #PB_Any
            OpenFile(scanner\currentFile, scanner\token\token, #PB_File_SharedRead)
            FlushFileBuffers(scanner\fileoutputchannel)
          Else
            PrintN("ERROR in FILE command. Line: " + Str(scanner\linecount))
          EndIf
          Goto READCARD1
        EndIf
        If Left(scanner\line_s, 6) = "#LABEL" 
          If scanner\doingToScreen = #True 
            PrintN("LINE: " +Str(scanner\linecount))
            PrintN(scanner\line_s)
          EndIf
          scanner\line_s = Mid(scanner\line_s, 7,Len(scanner\line_s)) 
          If GETANID() > 0 
            scanner\LabelName = scanner\token\token
            scanner\labelnumber = 0
          EndIf
          Goto READCARD1
        EndIf
        If Left(scanner\line_s, 4) = "#LIB" 
          If scanner\doingToScreen = #True 
            PrintN("LINE: " +Str(scanner\linecount))
            PrintN(scanner\line_s)
          EndIf
          scanner\line_s = Mid(scanner\line_s, 5,Len(scanner\line_s))
          If GETANID() > 0 
            scanner\libInProgress + 1
            scanner\filelibraries(scanner\libInProgress) = scanner\token\token
            OpenFile(scanner\libInProgress, scanner\filelibraries(scanner\libInProgress), #PB_File_SharedRead)
            FlushFileBuffers(scanner\fileoutputchannel)
            scanner\currentFile = scanner\libInProgress
          Else
            PrintN("ERROR in LIB command. Line: " + scanner\linecount)
          EndIf
          Goto READCARD1
        EndIf
        If Left(scanner\line_s, 5) = "#MAIN" 
          scanner\line_s = Mid(scanner\line_s, 6,Len(scanner\line_s))
          If GETANID() > 0 
            scanner\mainIsSet = #True
            scanner\mainName = scanner\token\token
          EndIf
          If scanner\doingToScreen = #True 
            PrintN("LINE: " +Str(scanner\linecount))
            PrintN(scanner\line_s)
          EndIf
          Goto READCARD1
        EndIf
        If Left(scanner\line_s, 7) = "#SCREEN" 
          If scanner\doingToScreen = #True 
            scanner\doingToScreen = #False
          Else
            scanner\doingToScreen = #True
          EndIf
          Goto READCARD1
        EndIf
        If Left(scanner\line_s, 7) = "#DEBUGS"
          If scanner\DEBUGS = #True 
            scanner\DEBUGS = #False
          Else
            scanner\DEBUGS = #True
          EndIf
          Goto READCARD1
        EndIf
        If Left(scanner\line_s, 6) = "#TRACE" 
          If scanner\doingTrace = #True 
            scanner\doingTrace = #False
          Else
            scanner\doingTrace = #True
          EndIf
          Goto READCARD1
        EndIf
        If Left(scanner\line_s, 2) = "//" 
          Goto READCARD1
        Else
          PrintN("Incorrect ;#; command in file " + scanner\inFilename)
          PrintN(scanner\line_s)
        EndIf
      EndIf
    EndIf
    If Left(scanner\line_s, 2) = "@@" 
      If scanner\doingCode = #False 
         WriteStringN(scanner\fileoutputchannel, "")
         WriteStringN(scanner\fileoutputchannel, "; START OF USER CODE")
         WriteStringN(scanner\fileoutputchannel, "")
         scanner\doingCode = #True
      Else
         WriteStringN(scanner\fileoutputchannel, "")
         WriteStringN(scanner\fileoutputchannel, "; END   OF USER CODE")
         WriteStringN(scanner\fileoutputchannel, "")
         scanner\doingCode = #False
      EndIf
      Goto READCARD1
    EndIf
    If scanner\doingTrace = #True
       WriteStringN(scanner\fileoutputchannel, ";")
       WriteStringN(scanner\fileoutputchannel, "; "+ scanner\line_s)
       WriteStringN(scanner\fileoutputchannel, ";")
    EndIf
    If scanner\doingToScreen = #True 
      PrintN("LINE: " +Str(scanner\linecount))
      PrintN(scanner\line_s)
      ;PrintN("")
    EndIf
    If scanner\doingCode = #True 
       WriteStringN(scanner\fileoutputchannel, scanner\line_s)
      Goto READCARD1
    EndIf
    If Left(scanner\line_s, 2) = "//" 
      Goto READCARD1
    EndIf
    ProcedureReturn 1
  EndProcedure
  
  Procedure.i SPAN()
    scanner\line_s = Trim(scanner\line_s)
    While scanner\line_s = ""
      If READCARD() = #atEOF
        ProcedureReturn #atEOF
      EndIf
      scanner\line_s = Trim(scanner\line_s)
    Wend
    If scanner\columncount > 1 
      scanner\columncount = Len(scanner\line_s) - scanner\largestColumn
    EndIf
    ProcedureReturn 0
  EndProcedure
  
  Procedure.i GETANID()
    If SPAN() = #atEOF 
      ProcedureReturn (#atEOF|#GETANIDERROR)
    EndIf
    Select Asc(Mid(scanner\line_s, 1, 1))
      Case 65 To 90, 97 To 122, 95
      Default
        ProcedureReturn - #GETANIDERROR
    EndSelect
    scanner\token\token = ""
    Protected counter.i = 1
    While Mid(scanner\line_s, counter, 1) <> #CRLF$
      Select Asc(Mid(scanner\line_s, counter, 1))
        Case 65 To 90, 97 To 122, 48 To 57, 95
          scanner\token\token = scanner\token\token + Mid(scanner\line_s, counter, 1)
          counter + 1
        Default        
          scanner\line_s = Mid(scanner\line_s, counter, Len(scanner\line_s))
          scanner\columncount = Len(scanner\line_s)
          scanner\token\tokentype = #id
          ProcedureReturn counter - 1
          Break
      EndSelect
    Wend
    scanner\token\tokentype = #none
  EndProcedure
  
  Procedure.i GETINT()
    If SPAN() = #atEOF 
      ProcedureReturn (#atEOF|#GETINTERROR)
    EndIf
    Select Asc(Mid(scanner\line_s, 1, 1))
      Case 48 To 57
      Default
        ProcedureReturn -(#GETINTERROR)
    EndSelect
    scanner\token\token = ""
    Protected counter.l = 1
    While Mid(scanner\line_s, counter, 1) <> #CRLF$
      Select Asc(Mid(scanner\line_s, counter, 1))
        Case 48 To 57
          scanner\token\token = scanner\token\token + Mid(scanner\line_s, counter, 1)
          counter + 1 
        Default
          scanner\line_s = Mid(scanner\line_s, counter, Len(scanner\line_s))
          scanner\columncount = Len(scanner\line_s)
          scanner\token\tokentype = #integer
          ProcedureReturn counter-1
      EndSelect
    Wend
    scanner\token\tokentype = #none
  EndProcedure
  
  Procedure.i GETREAL()
    Protected counter.l = 1
    Protected matchPosition.l
    If SPAN() = #atEOF 
      ProcedureReturn -(#atEOF | #GETREALERROR)
    EndIf
    Select Asc(Mid(scanner\line_s, 1, 1))
      Case Asc("0") To Asc("9")
        counter = 1
      Case Asc(".")
        If IsDigit(Mid(scanner\line_s, 1, 1)) 
          counter = 2
        Else
          ProcedureReturn -(#atEOF | #GETREALERROR)
        EndIf          
      Default
        ProcedureReturn -(#atEOF | #GETREALERROR)
    EndSelect
    While Mid(scanner\line_s, counter, 1) <> #CRLF$
      Select  Asc(Mid(scanner\line_s, counter, 1))
        Case Asc("0") To Asc("9")
          scanner\token\token = scanner\token\token + Mid(scanner\line_s, counter, 1)
          counter + 1 
        Default
          counter - 1
          Break
      EndSelect
    Wend
    If Mid(scanner\line_s, counter, 1) <> #CRLF$ 
      If Mid(scanner\line_s, counter+1, 1) = "E" Or Mid(scanner\line_s, counter, 1) = "e" 
        If Mid(scanner\line_s, counter+2, 1) = "+" Or Mid(scanner\line_s, counter, 1) = "-" 
          counter + 2
          scanner\token\token = scanner\token\token + Mid(scanner\line_s, counter, 1)
        Else
          counter + 1
        EndIf
        While Mid(scanner\line_s, counter, 1) <> #CRLF$
          Select  Asc(Mid(scanner\line_s, counter, 1))
            Case Asc("0") To Asc("9")
              scanner\token\token = scanner\token\token + Mid(scanner\line_s, counter, 1)
              counter + 1 
            Default
              counter - 1
              Break
          EndSelect
        Wend
      EndIf
    EndIf
    scanner\token\token = Mid(scanner\line_s, 1, counter)
    scanner\line_s = Mid(scanner\line_s, counter+1, Len(scanner\line_s))
    If counter > 1 
      scanner\columncount = Len(scanner\line_s)
      scanner\token\tokentype = #float
      ProcedureReturn counter
    Else
      scanner\token\tokentype = #none
      ProcedureReturn -(#GETREALERROR)
    EndIf
  EndProcedure
  
  Procedure.i GETSTRING()
    If SPAN() = #atEOF 
      ProcedureReturn (#atEOF|#GETSTRINGERROR)
    EndIf
    If Mid(scanner\line_s, 1, 1) = Chr(34) 
      Protected counter.l = 2
      While Mid(scanner\line_s, counter, 1) <> #CRLF$
        If Mid(scanner\line_s, counter, 1) = Chr(34)
          scanner\token\token = Mid(scanner\line_s, 1, counter)
          counter + 1
          scanner\line_s = Mid(scanner\line_s, counter, Len(scanner\line_s))
          scanner\token\tokentype = #string
          ProcedureReturn counter
        Else
          counter + 1
        EndIf
      Wend
    EndIf
    scanner\token\tokentype = #none
    ProcedureReturn -(#GETSTRINGERROR)
  EndProcedure
  
  Procedure.i GETANYCHAR()
    If scanner\line_s = "" 
      If SPAN() = #atEOF 
        ProcedureReturn (#atEOF|#GETANYCHARERROR)
      EndIf
    EndIf
    scanner\token\token = Mid(scanner\line_s, 1, 1)
    scanner\line_s = Mid(scanner\line_s, 2, 1)
    scanner\token\tokentype = #anychar
    ProcedureReturn 1
  EndProcedure
  
  Procedure.i DOCODES(untils.s)
    Protected counter.l
    Repeat
      If scanner\line_s = "" 
        If SPAN() = #atEOF
          scanner\columncount = Len(scanner\line_s)
          ProcedureReturn (#atEOF|#CODEERROR)
        EndIf
      EndIf
      counter = FindString(scanner\line_s, untils,1)
      If counter > 0 
        WriteStringN(scanner\fileoutputchannel, Mid(scanner\line_s, 1, counter-1))
        scanner\line_s = Mid(scanner\line_s, counter + Len(untils), Len(scanner\line_s)) 
        scanner\columncount = Len(scanner\line_s)
        scanner\token\tokentype = #code
        ProcedureReturn 1
      EndIf
      WriteStringN(scanner\fileoutputchannel, scanner\line_s)
      scanner\line_s = ""
    ForEver
    ProcedureReturn -(#CODEERROR)
  EndProcedure
  
  Procedure.i TESTTOKEN(stoken.s)
    If SPAN() = #atEOF 
      ProcedureReturn (#atEOF | #TESTTOKENERROR)
    EndIf
    Protected counter.i = Len(stoken)
    If Mid(scanner\line_s, 1, counter) = stoken 
      scanner\token\token = Mid(scanner\line_s, 1, counter)
      scanner\line_s = Mid(scanner\line_s, counter+1, Len(scanner\line_s)) 
      scanner\columncount = Len(scanner\line_s)
      ProcedureReturn counter
    EndIf
    ProcedureReturn -(#TESTTOKENERROR)
  EndProcedure
  
  Procedure.i COLLECTTO(CollectChars.s)
    scanner\token\token = ""
    Repeat
      If scanner\line_s = "" 
        If SPAN() = #atEOF 
          ProcedureReturn (#atEOF|#COLLECTTOERROR)
        EndIf
      EndIf
      Protected counter.i = FindString(scanner\line_s, CollectChars, #PB_String_CaseSensitive)
      If counter > 0 
        scanner\line_s = Mid(scanner\line_s, counter + Len(CollectChars), Len(scanner\line_s))
        scanner\token\token = scanner\token\token + Mid(scanner\line_s, 1, counter)
        Break
      EndIf
      scanner\token\token = scanner\token\token + scanner\line_s
      scanner\line_s = ""
    ForEver
    scanner\columncount = Len(scanner\line_s)
    scanner\token\tokentype = #collect
    ProcedureReturn Len(scanner\token\token)
  EndProcedure
  
  Procedure.i GETNOT(NotChar.s)
    If COLLECTTO(NotChar) > 0 
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  EndProcedure
  
  Procedure.i SYNCTO(SyncChar.s)
    Protected counter.i = Len(SyncChar)
    Repeat
      If Mid(scanner\line_s, 1, counter) <> SyncChar 
        scanner\line_s = Mid(scanner\line_s, counter+1,Len(scanner\line_s))
        If SPAN() = #atEOF 
          ProcedureReturn (#atEOF | #SYNCTOERROR)
        EndIf
      Else
        scanner\columncount = Len(scanner\line_s)
        ProcedureReturn 1
      EndIf
    ForEver
  EndProcedure
  
  Procedure SAVETEMP(SaveStrings.s = "")
    If SaveStrings = "" 
      scanner\SaveString = scanner\SaveString + scanner\token\token
      scanner\token\token = ""
    Else
      scanner\SaveString = scanner\SaveString + SaveStrings
    EndIf
  EndProcedure
  
  Procedure DOLABEL(lmode.i, generate.i)
    Select lmode
      Case #DOESNEW
        scanner\labelnumber + 1
        scanner\token\token = scanner\LabelName + Trim(Str(scanner\labelnumber))
        Select  generate
          Case #DOESOUT
            scanner\OutString = scanner\OutString + scanner\token\token
          Case #DOESSAVE
            scanner\SaveString = scanner\SaveString + scanner\token\token
        EndSelect
      Case #DOESPREVIOUS
        Select  generate
          Case #DOESOUT
            scanner\OutString = scanner\OutString + scanner\token\token
          Case #DOESSAVE
            scanner\SaveString = scanner\SaveString + scanner\token\token
        EndSelect
    EndSelect
  EndProcedure
  
  Procedure.i STACKS(fromwhat.i, stringvals.s = "", type.i=#none, whichs.i = 0)
    Protected which.i
;     Protected stringval.s
;     stringval = stringvals
    which = whichs
    scanner\stackpointer(which) + 1
    If scanner\stackpointer(which) < #MAXINSTACK 
      If fromwhat = #FROMSAVE 
        scanner\stack(which, scanner\stackpointer(which))\token = scanner\SaveString
        scanner\stack(which, scanner\stackpointer(which))\tokentype = type
        scanner\SaveString = ""
      Else
        If fromwhat = #FROMTOKEN 
          scanner\stack(which, scanner\stackpointer(which))\token = scanner\token\token
          If type = #none And scanner\token\tokentype <> #none
            scanner\stack(which, scanner\stackpointer(which))\tokentype = scanner\token\tokentype
          Else
            scanner\stack(which, scanner\stackpointer(which))\tokentype = type
          EndIf
          scanner\token\token = ""
        Else
          scanner\stack(which, scanner\stackpointer(which))\token = stringvals
          scanner\stack(which, scanner\stackpointer(which))\tokentype = type
        EndIf
      EndIf
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  EndProcedure
  
  Procedure POPSTACK(whichs.i = 0)
    Protected which.i
    which = whichs
    If scanner\stackpointer(which) > 0 
      scanner\token\token = scanner\stack(which, scanner\stackpointer(which))\token
      scanner\token\tokentype = scanner\stack(which, scanner\stackpointer(which))\tokentype
      scanner\stack(which, scanner\stackpointer(which))\token = ""
      scanner\stack(which, scanner\stackpointer(which))\tokentype = #none
      scanner\stackpointer(which) - 1
    EndIf
  EndProcedure
  
  Procedure PEEKSTACK(element.i, whichs.i=0)
    Protected which.i
    which = whichs
    If element > 0 
      scanner\token\token = scanner\stack(which, element)\token
      scanner\token\tokentype = scanner\stack(which, element)\tokentype
    EndIf
  EndProcedure
  
  Procedure PEEPSTACK(whichs.i=0)
    Protected which.i
    which = whichs
    If scanner\stackpointer(which) > 0 
      scanner\token\token = scanner\stack(which, scanner\stackpointer(which))\token
      scanner\token\tokentype = scanner\stack(which, scanner\stackpointer(which))\tokentype
    EndIf
  EndProcedure
  
  Procedure EMIT(EmitString.s, whichs.i=0)
    Protected which.i
    which = whichs
    If which = #FROMOUT 
      scanner\OutString = scanner\OutString + scanner\token\token
    Else
      If which = #FROMSAVE 
        scanner\OutString = scanner\OutString + scanner\SaveString
      Else
        If which = #FROMSTRING 
          scanner\OutString = scanner\OutString + Chr(34) + scanner\token\token + Chr(34)
        Else
          scanner\OutString = scanner\OutString + EmitString
        EndIf
      EndIf
    EndIf
  EndProcedure
  
  Procedure FLUSH()
    WriteStringN(scanner\fileoutputchannel, scanner\OutString)
    scanner\OutString = ""
  EndProcedure

EndModule
Top
startup
Enthusiast
Enthusiast
Posts: 105
Joined: Wed Feb 25, 2015 5:55 pm

Re: meta pi compiler compiler

Post by startup »

some stupid demo bnf

Code: Select all

//#SCREEN
//#TRACE
//#MAIN float1
//#LABEL lx
//#DEBUGS
//#LIB TEST1

sentence := $(rule | prompt|translation) ;
rule := .INT "IF" condition "THEN" conclusion "." ;
condition := condition_clause {("AND"|"OR") {"NOT"} condition};
condition_clause := .ID "IS" .ID | function_attribute ;
function_attribute := "FUNCTION" .GETSTRING "(" paramlist ")" ;
paramlist := paramitem $("," paramitem);
paramitem := .GETSTRING | "'" .INT {"," .INT} "'" ;
conclusion:= conclusionclause {("AND"|"OR") {"NOT"} conclusionclause};
conclusionclause:= .GETSTRING "IS" (procedurevalue | (.GETSTRING | .INT {"," .INT}));
procedurevalue:="PROCEDURE" .GETSTRING "(" paramlist ")";
prompt:= ("PROMP"| "NUMERIC PROMPT") .GETSTRING .COLLECT2(".");
translation:= "TRANS" .GETSTRING .COLLECT2(".");


in module_scanner

Code: Select all

OpenConsole("MetaPi Compiler @RKO")
CREATES("TEST11", "metaout.pbi")
          ^bnf file name   ^outputfilename
prog()
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
generated output

Code: Select all

; Created with: MetaPi Compiler @RKO 2015

XIncludeFile "modul_scanner.pbi"
 UseModule  meta_scanner
XIncludeFile "metaout_inc.pbi"

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i sentence()
  Protected perr.i = 0
METAPI1:
  IF perr < 0
    GOTO METAPI2
  EndIf
  perr = rule()
  IF perr < 0
    GOTO METAPI4
  EndIf
METAPI4: 
  IF perr > 0
    Goto METAPI3
  EndIf
  perr = prompt()
  IF perr < 0
    GOTO METAPI5
  EndIf
METAPI5: 
  IF perr > 0
    Goto METAPI3
  EndIf
  perr = translation()
  IF perr < 0
    GOTO METAPI6
  EndIf
METAPI6: 
METAPI3: 
  IF perr < 0
    GOTO METAPI7
  EndIf
METAPI7: 
  GOTO METAPI1
METAPI2:
  perr = 1
  ProcedureReturn perr 
METAPI8:
  ProcedureReturn perr 
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i rule()
  Protected perr.i = 0
  perr = GETINT()
  IF perr < 0
    GOTO METAPI9
  EndIf
  perr = TESTTOKEN("IF")
  IF perr < 0
    GOTO METAPI9
  EndIf
  perr = condition()
  IF perr < 0
    GOTO METAPI9
  EndIf
  perr = TESTTOKEN("THEN")
  IF perr < 0
    GOTO METAPI9
  EndIf
  perr = conclusion()
  IF perr < 0
    GOTO METAPI9
  EndIf
  perr = TESTTOKEN(".")
  IF perr < 0
    GOTO METAPI9
  EndIf
  ProcedureReturn perr 
METAPI9:
  ProcedureReturn perr 
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i condition()
  Protected perr.i = 0
  perr = condition_clause()
  IF perr < 0
    GOTO METAPI10
  EndIf
  perr = TESTTOKEN("AND")
  IF perr < 0
    GOTO METAPI13
  EndIf
METAPI13: 
  IF perr > 0
    Goto METAPI12
  EndIf
  perr = TESTTOKEN("OR")
  IF perr < 0
    GOTO METAPI14
  EndIf
METAPI14: 
METAPI12: 
  IF perr < 0
    GOTO METAPI15
  EndIf
  perr = TESTTOKEN("NOT")
  IF perr < 0
    GOTO METAPI17
  EndIf
METAPI17: 
  perr = 1
METAPI16:
  perr = condition()
  IF perr < 0
    GOTO METAPI15
  EndIf
METAPI15: 
  perr = 1
METAPI11:
  ProcedureReturn perr 
METAPI10:
  ProcedureReturn perr 
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i condition_clause()
  Protected perr.i = 0
  perr = GETANID()
  IF perr < 0
    GOTO METAPI18
  EndIf
  perr = TESTTOKEN("IS")
  IF perr < 0
    GOTO METAPI18
  EndIf
  perr = GETANID()
  IF perr < 0
    GOTO METAPI18
  EndIf
  ProcedureReturn perr 
METAPI18:
  perr = function_attribute()
  IF perr < 0
    GOTO METAPI19
  EndIf
  ProcedureReturn perr 
METAPI19:
  ProcedureReturn perr 
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i function_attribute()
  Protected perr.i = 0
  perr = TESTTOKEN("FUNCTION")
  IF perr < 0
    GOTO METAPI20
  EndIf
  perr = GETSTRING()
  IF perr < 0
    GOTO METAPI20
  EndIf
  perr = TESTTOKEN("(")
  IF perr < 0
    GOTO METAPI20
  EndIf
  perr = paramlist()
  IF perr < 0
    GOTO METAPI20
  EndIf
  perr = TESTTOKEN(")")
  IF perr < 0
    GOTO METAPI20
  EndIf
  ProcedureReturn perr 
METAPI20:
  ProcedureReturn perr 
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i paramlist()
  Protected perr.i = 0
  perr = paramitem()
  IF perr < 0
    GOTO METAPI21
  EndIf
METAPI22:
  IF perr < 0
    GOTO METAPI23
  EndIf
  perr = TESTTOKEN(",")
  IF perr < 0
    GOTO METAPI25
  EndIf
  perr = paramitem()
  IF perr < 0
    GOTO METAPI25
  EndIf
METAPI25: 
METAPI24: 
  IF perr < 0
    GOTO METAPI26
  EndIf
METAPI26: 
  GOTO METAPI22
METAPI23:
  perr = 1
  ProcedureReturn perr 
METAPI21:
  ProcedureReturn perr 
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i paramitem()
  Protected perr.i = 0
  perr = GETSTRING()
  IF perr < 0
    GOTO METAPI27
  EndIf
  ProcedureReturn perr 
METAPI27:
  perr = TESTTOKEN("'")
  IF perr < 0
    GOTO METAPI28
  EndIf
  perr = GETINT()
  IF perr < 0
    GOTO METAPI28
  EndIf
  perr = TESTTOKEN(",")
  IF perr < 0
    GOTO METAPI30
  EndIf
  perr = GETINT()
  IF perr < 0
    GOTO METAPI30
  EndIf
METAPI30: 
  perr = 1
METAPI29:
  perr = TESTTOKEN("'")
  IF perr < 0
    GOTO METAPI28
  EndIf
  ProcedureReturn perr 
METAPI28:
  ProcedureReturn perr 
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i conclusion()
  Protected perr.i = 0
  perr = conclusionclause()
  IF perr < 0
    GOTO METAPI31
  EndIf
  perr = TESTTOKEN("AND")
  IF perr < 0
    GOTO METAPI34
  EndIf
METAPI34: 
  IF perr > 0
    Goto METAPI33
  EndIf
  perr = TESTTOKEN("OR")
  IF perr < 0
    GOTO METAPI35
  EndIf
METAPI35: 
METAPI33: 
  IF perr < 0
    GOTO METAPI36
  EndIf
  perr = TESTTOKEN("NOT")
  IF perr < 0
    GOTO METAPI38
  EndIf
METAPI38: 
  perr = 1
METAPI37:
  perr = conclusionclause()
  IF perr < 0
    GOTO METAPI36
  EndIf
METAPI36: 
  perr = 1
METAPI32:
  ProcedureReturn perr 
METAPI31:
  ProcedureReturn perr 
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i conclusionclause()
  Protected perr.i = 0
  perr = GETSTRING()
  IF perr < 0
    GOTO METAPI39
  EndIf
  perr = TESTTOKEN("IS")
  IF perr < 0
    GOTO METAPI39
  EndIf
  perr = procedurevalue()
  IF perr < 0
    GOTO METAPI41
  EndIf
METAPI41: 
  IF perr > 0
    Goto METAPI40
  EndIf
  perr = GETSTRING()
  IF perr < 0
    GOTO METAPI43
  EndIf
METAPI43: 
  IF perr > 0
    Goto METAPI42
  EndIf
  perr = GETINT()
  IF perr < 0
    GOTO METAPI44
  EndIf
  perr = TESTTOKEN(",")
  IF perr < 0
    GOTO METAPI46
  EndIf
  perr = GETINT()
  IF perr < 0
    GOTO METAPI46
  EndIf
METAPI46: 
  perr = 1
METAPI45:
METAPI44: 
METAPI42: 
  IF perr < 0
    GOTO METAPI47
  EndIf
METAPI47: 
METAPI40: 
  IF perr < 0
    GOTO METAPI39
  EndIf
  ProcedureReturn perr 
METAPI39:
  ProcedureReturn perr 
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i procedurevalue()
  Protected perr.i = 0
  perr = TESTTOKEN("PROCEDURE")
  IF perr < 0
    GOTO METAPI48
  EndIf
  perr = GETSTRING()
  IF perr < 0
    GOTO METAPI48
  EndIf
  perr = TESTTOKEN("(")
  IF perr < 0
    GOTO METAPI48
  EndIf
  perr = paramlist()
  IF perr < 0
    GOTO METAPI48
  EndIf
  perr = TESTTOKEN(")")
  IF perr < 0
    GOTO METAPI48
  EndIf
  ProcedureReturn perr 
METAPI48:
  ProcedureReturn perr 
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i prompt()
  Protected perr.i = 0
  perr = TESTTOKEN("PROMP")
  IF perr < 0
    GOTO METAPI50
  EndIf
METAPI50: 
  IF perr > 0
    Goto METAPI49
  EndIf
  perr = TESTTOKEN("NUMERIC PROMPT")
  IF perr < 0
    GOTO METAPI51
  EndIf
METAPI51: 
METAPI49: 
  IF perr < 0
    GOTO METAPI52
  EndIf
  perr = GETSTRING()
  IF perr < 0
    GOTO METAPI52
  EndIf
  COLLECTTO(".");
  if perr < 0
    ProcedureReturn perr
  endif
  ProcedureReturn perr 
METAPI52:
  ProcedureReturn perr 
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i translation()
  Protected perr.i = 0
  perr = TESTTOKEN("TRANS")
  IF perr < 0
    GOTO METAPI53
  EndIf
  perr = GETSTRING()
  IF perr < 0
    GOTO METAPI53
  EndIf
  COLLECTTO(".");
  if perr < 0
    ProcedureReturn perr
  endif
  ProcedureReturn perr 
METAPI53:
  ProcedureReturn perr 
EndProcedure
Top
startup
Enthusiast
Enthusiast
Posts: 105
Joined: Wed Feb 25, 2015 5:55 pm

Re: meta pi compiler compiler

Post by startup »

another little demo with stupid attributes

Code: Select all

//#SCREEN
//#TRACE
//#MAIN float1
//#LABEL prim

paramitem(*t.scan) := .GETSTRING:str | "'" .INT:intt {"," .INT} "'" .dummy(@t, str, intt) ;

#END
generates

Code: Select all

; Created with: MetaPi Compiler @RKO 2015

XIncludeFile "modul_scanner.pbi"
 UseModule  meta_scanner
XIncludeFile "metaout_inc.pbi"

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i paramitem(*t.scan)
  Protected perr.i = 0
  perr = GETSTRING()
  Protected str.s = chr(34)+scanner\token\token+chr(34)
  IF perr < 0
    GOTO METAPI1
  EndIf
  ProcedureReturn perr 
METAPI1:
  perr = TESTTOKEN("'")
  IF perr < 0
    GOTO METAPI2
  EndIf
  perr = GETINT()
  Protected intt.i =  val(scanner\token\token)
  IF perr < 0
    GOTO METAPI2
  EndIf
  perr = TESTTOKEN(",")
  IF perr < 0
    GOTO METAPI4
  EndIf
  perr = GETINT()
  IF perr < 0
    GOTO METAPI4
  EndIf
METAPI4: 
  perr = 1
METAPI3:
  perr = TESTTOKEN("'")
  IF perr < 0
    GOTO METAPI2
  EndIf
  perr = dummy(@t,str,intt)
  ProcedureReturn perr 
METAPI2:
  ProcedureReturn perr 
EndProcedure
Top
startup
Enthusiast
Enthusiast
Posts: 105
Joined: Wed Feb 25, 2015 5:55 pm

Re: meta pi compiler compiler

Post by startup »

did a little update - the last, it does what i need. if you wand to take the source and do changes, delete the copywrite and go for it - just make sure to post the changed source and use it for wat ever you wand - free as beer.
  • stand alone console meta pi compiler
    call with infile optinal outfile
    some color,
    bug fixes,
    infusion of minimal scanner primitives (need mothering to make faster)
    recognizes duplicate rules and reports them
    everything compiled into one file
a demo bnf for a workable program will follow, but look at the previous samples and the source code
Last edited by startup on Wed Oct 14, 2015 8:50 pm, edited 1 time in total.
Top
startup
Enthusiast
Enthusiast
Posts: 105
Joined: Wed Feb 25, 2015 5:55 pm

Re: meta pi compiler compiler

Post by startup »

part 1: meta pi

Code: Select all

XIncludeFile "modul_scanner.pbi"

EnableExplicit
UseModule meta_scanner

;;;;;;;; insert part 2 HERE


Procedure.s FindDuplicateRulenames(ruledefinition.s)
  Protected.i f=0, location = FindString(ruledefinition, "(")
  If location > 0
    Protected.s comp, rulename = Mid(ruledefinition, 1, location-1)
    ResetMap(meta_scanner::prototypes())
    While NextMapElement(meta_scanner::prototypes())
      comp = Mid(meta_scanner::prototypes(), 1, location-1)
      If comp = rulename
        f = 1
        Break
      EndIf
    Wend
    If f=1
      ProcedureReturn rulename
    EndIf
    ProcedureReturn ""
  EndIf
EndProcedure

Declare.i elem()
Declare.i entry()
Declare.i stmt()
Declare.i prog()
Declare.i elem2()
Declare.i typ1()
Declare.i typ2() 
Declare.i expr()
Declare.i elemxp()
Declare.i entry2()
Declare.i too()
Declare.i zero()
Declare.i codes()
Declare.i getcode()
Declare.i recurs()
Declare.i look()
Declare.i errtext()
Declare.i nexts()
Declare.i prim()
Declare.i snm()
Declare.i labels()
Declare.i SEM1()
Declare.i SEM_a1()
Declare.i SEM_b1()
Declare.i SEM2()
Declare.i SEM3()
Declare.i SEM4()
Declare.i SEM5()
Declare.i SEM6()
Declare.i SEM7()
Declare.i SEM8()
Declare.i SEM9()
Declare.i SEM10()
Declare.i SEM11()
Declare.i SEM12()
Declare.i SEM13()
Declare.i SEM14()
Declare.i SEM15()
Declare.i SEM16()
Declare.i SEM17()
Declare.i SEM17a()
Declare.i SEM18()
Declare.i SEM19()
Declare.i SEM20()
Declare.i SEM21()
Declare.i SEM22()
Declare.i SEM22a()
Declare.i SEM23()
Declare.i SEM25()
Declare.i SEM26()
Declare.i SEM27()
Declare.i SEM30()
Declare.i EMPTY()

Global.s prototypestring = "", duplicate = ""

Procedure.i prog()
  Protected  perr.i
  PrintN("MetaPi Compiler @RKO 2015")
  FLUSH()
  FLUSH()
  perr = stmt()
  If perr < 0 
    Goto metapi0 ;ProcedureReturn perr
  EndIf
 metapi1:
  perr = stmt()
  If perr < 0  
    Goto metapi2
  EndIf
  Goto metapi1
 metapi2:
  perr = TESTTOKEN("#END")
metapi0:  
  If perr < 0  ;;;;; some error handling
    ConsoleColor(4, 0)
    WriteStringN(scanner\fileoutputchannel,"Error: in line " + Str(scanner\linecount))
    ConsoleColor(2, 0)
    WriteStringN(scanner\fileoutputchannel,scanner\org_line)
    WriteStringN(scanner\fileoutputchannel,Space((Len(scanner\org_line) - Len(scanner\line_s)))+"^")
    ConsoleColor(14, 0)
    PrintN("Error: in line " + Str(scanner\linecount))
    PrintN(scanner\org_line)
    PrintN(Space((Len(scanner\org_line) - Len(scanner\line_s)))+"^")
    ConsoleColor(2, 0)
    ;Goto metapi1
  EndIf
  ConsoleColor(14, 0)
  PrintN("Done compiling " + Str(scanner\linecount) + " lines of BNF")
  ConsoleColor(2, 0)
  PrintN("Hit Enter to end the program")
  ProcedureReturn perr
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i pointerheader()
  Protected perr.i = 0
  perr = TESTTOKEN("*")
  If perr < 0
    Goto new1
  EndIf
  SEM_a1()
  perr = GETANID()
  If perr < 0
    Goto new1
  EndIf
  SEM_a1()
  perr = TESTTOKEN(".")
  If perr < 0
    Goto new1
  EndIf
  SEM_a1()
  perr = TESTTOKEN("integer")
  If perr < 0
    Goto new3
  EndIf
new3: 
  If perr > 0
    Goto new2
  EndIf
  perr = TESTTOKEN("string")
  If perr < 0
    Goto new4
  EndIf
new4: 
  If perr > 0
    Goto new2
  EndIf
  perr = TESTTOKEN("double")
  If perr < 0
    Goto new5
  EndIf
new5: 
  If perr > 0
    Goto new2
  EndIf
  perr = TESTTOKEN("Float")
  If perr < 0
    Goto new6
  EndIf
new6: 
  If perr > 0
    Goto new2
  EndIf
  perr = TESTTOKEN("Quad")
  If perr < 0
    Goto new7
  EndIf
new7: 
  If perr > 0
    Goto new2
  EndIf
  perr = TESTTOKEN("Unicode")
  If perr < 0
    Goto new8
  EndIf
new8: 
  If perr > 0
    Goto new2
  EndIf
  perr = TESTTOKEN("Character")
  If perr < 0
    Goto new9
  EndIf
new9: 
  If perr > 0
    Goto new2
  EndIf
  perr = TESTTOKEN("byte")
  If perr < 0
    Goto new10
  EndIf
new10: 
  If perr > 0
    Goto new2
  EndIf
  perr = TESTTOKEN("Ascii")
  If perr < 0
    Goto new11
  EndIf
new11: 
  If perr > 0
    Goto new2
  EndIf
  perr = GETANID()
  If perr < 0
    Goto new12
  EndIf
new12: 
new2: 
  If perr < 0
    Goto new1
  EndIf
  SEM_a1()
new13:
  If perr < 0
    Goto new14
  EndIf
  perr = TESTTOKEN(",")
  If perr < 0
    Goto new16
  EndIf
  SEM_a1()
  perr = TESTTOKEN("*")
  If perr < 0
    Goto new16
  EndIf
  SEM_a1()
  perr = GETANID()
  If perr < 0
    Goto new16
  EndIf
  SEM_a1()
  perr = TESTTOKEN(".")
  If perr < 0
    Goto new16
  EndIf
  SEM_a1()
  perr = TESTTOKEN("integer")
  If perr < 0
    Goto new18
  EndIf
new18: 
  If perr > 0
    Goto new17
  EndIf
  perr = TESTTOKEN("string")
  If perr < 0
    Goto new19
  EndIf
new19: 
  If perr > 0
    Goto new17
  EndIf
  perr = TESTTOKEN("double")
  If perr < 0
    Goto new20
  EndIf
new20: 
  If perr > 0
    Goto new17
  EndIf
  perr = TESTTOKEN("Float")
  If perr < 0
    Goto new21
  EndIf
new21: 
  If perr > 0
    Goto new17
  EndIf
  perr = TESTTOKEN("Quad")
  If perr < 0
    Goto new22
  EndIf
new22: 
  If perr > 0
    Goto new17
  EndIf
  perr = TESTTOKEN("Unicode")
  If perr < 0
    Goto new23
  EndIf
new23: 
  If perr > 0
    Goto new17
  EndIf
  perr = TESTTOKEN("Character")
  If perr < 0
    Goto new24
  EndIf
new24: 
  If perr > 0
    Goto new17
  EndIf
  perr = TESTTOKEN("byte")
  If perr < 0
    Goto new25
  EndIf
new25: 
  If perr > 0
    Goto new17
  EndIf
  perr = TESTTOKEN("Ascii")
  If perr < 0
    Goto new26
  EndIf
new26: 
  If perr > 0
    Goto new17
  EndIf
  perr = GETANID()
  If perr < 0
    Goto new27
  EndIf
new27: 
new17: 
  If perr < 0
    Goto new16
  EndIf
  SEM_a1()
new16: 
new15: 
  If perr < 0
    Goto new28
  EndIf
new28: 
  Goto new13
new14:
  perr = 1
  ProcedureReturn perr 
new1:
  ProcedureReturn perr 
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i regularheader()
  Protected perr.i = 0
  perr = GETANID()
  If perr < 0
    Goto new29
  EndIf
  SEM_a1()
  perr = TESTTOKEN(".")
  If perr < 0
    Goto new29
  EndIf
  SEM_a1()
  perr = TESTTOKEN("i")
  If perr < 0
    Goto new31
  EndIf
new31: 
  If perr > 0
    Goto new30
  EndIf
  perr = TESTTOKEN("s")
  If perr < 0
    Goto new32
  EndIf
new32: 
  If perr > 0
    Goto new30
  EndIf
  perr = TESTTOKEN("d")
  If perr < 0
    Goto new33
  EndIf
new33: 
  If perr > 0
    Goto new30
  EndIf
  perr = TESTTOKEN("f")
  If perr < 0
    Goto new34
  EndIf
new34: 
  If perr > 0
    Goto new30
  EndIf
  perr = TESTTOKEN("q")
  If perr < 0
    Goto new35
  EndIf
new35: 
  If perr > 0
    Goto new30
  EndIf
  perr = TESTTOKEN("u")
  If perr < 0
    Goto new36
  EndIf
new36: 
  If perr > 0
    Goto new30
  EndIf
  perr = TESTTOKEN("c")
  If perr < 0
    Goto new37
  EndIf
new37: 
  If perr > 0
    Goto new30
  EndIf
  perr = TESTTOKEN("b")
  If perr < 0
    Goto new38
  EndIf
new38: 
  If perr > 0
    Goto new30
  EndIf
  perr = TESTTOKEN("a")
  If perr < 0
    Goto new39
  EndIf
new39: 
new30: 
  If perr < 0
    Goto new29
  EndIf
  SEM_a1()
new40:
  If perr < 0
    Goto new41
  EndIf
  perr = TESTTOKEN(",")
  If perr < 0
    Goto new43
  EndIf
  SEM_a1()
  perr = GETANID()
  If perr < 0
    Goto new43
  EndIf
  SEM_a1()
  perr = TESTTOKEN(".")
  If perr < 0
    Goto new43
  EndIf
  SEM_a1()
  perr = TESTTOKEN("i")
  If perr < 0
    Goto new45
  EndIf
new45: 
  If perr > 0
    Goto new44
  EndIf
  perr = TESTTOKEN("s")
  If perr < 0
    Goto new46
  EndIf
new46: 
  If perr > 0
    Goto new44
  EndIf
  perr = TESTTOKEN("d")
  If perr < 0
    Goto new47
  EndIf
new47: 
  If perr > 0
    Goto new44
  EndIf
  perr = TESTTOKEN("f")
  If perr < 0
    Goto new48
  EndIf
new48: 
  If perr > 0
    Goto new44
  EndIf
  perr = TESTTOKEN("q")
  If perr < 0
    Goto new49
  EndIf
new49: 
  If perr > 0
    Goto new44
  EndIf
  perr = TESTTOKEN("u")
  If perr < 0
    Goto new50
  EndIf
new50: 
  If perr > 0
    Goto new44
  EndIf
  perr = TESTTOKEN("c")
  If perr < 0
    Goto new51
  EndIf
new51: 
  If perr > 0
    Goto new44
  EndIf
  perr = TESTTOKEN("b")
  If perr < 0
    Goto new52
  EndIf
new52: 
  If perr > 0
    Goto new44
  EndIf
  perr = TESTTOKEN("a")
  If perr < 0
    Goto new53
  EndIf
new53: 
new44: 
  If perr < 0
    Goto new43
  EndIf
  SEM_a1()
new43: 
new42: 
  If perr < 0
    Goto new54
  EndIf
new54: 
  Goto new40
new41:
  perr = 1
  ProcedureReturn perr 
new29:
  ProcedureReturn perr 
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i stmt()
  Protected perr.i = 0
  perr = GETANID()
  If perr < 0
    Goto new55
  EndIf
  SEM_a1()
  perr = TESTTOKEN("(")
  If perr < 0
    Goto new57
  EndIf
  SEM_a1()
  perr = pointerheader()
  If perr < 0
    Goto new59
  EndIf
new59: 
  If perr > 0
    Goto new58
  EndIf
  perr = regularheader()
  If perr < 0
    Goto new60
  EndIf
new60: 
new58: 
  If perr < 0
    Goto new57
  EndIf
new61:
  If perr < 0
    Goto new62
  EndIf
  perr = pointerheader()
  If perr < 0
    Goto new64
  EndIf
new64: 
  If perr > 0
    Goto new63
  EndIf
  perr = regularheader()
  If perr < 0
    Goto new65
  EndIf
new65: 
new63: 
  If perr < 0
    Goto new66
  EndIf
new66: 
  Goto new61
new62:
  perr = 1
  perr = TESTTOKEN(")")
  If perr < 0
    Goto new57
  EndIf
  SEM_a1()
  SEM_b1()
new57: 
  If perr > 0
    Goto new56
  EndIf
  SEM1()
  perr = 1
new67: 
new56: 
  If perr < 0
    Goto new55
  EndIf
  perr = TESTTOKEN(":=")
  If perr < 0
    Goto new55
  EndIf
  perr = entry()
  If perr < 0
    Goto new55
  EndIf
new68:
  If perr < 0
    Goto new69
  EndIf
  perr = TESTTOKEN("|")
  If perr < 0
    Goto new71
  EndIf
  perr = entry()
  If perr < 0
    Goto new71
  EndIf
new71: 
new70: 
  If perr < 0
    Goto new72
  EndIf
new72: 
  Goto new68
new69:
  perr = 1
  SEM4()
  SYNCTO(";");
  perr = TESTTOKEN(";")
  If perr < 0
    Goto new55
  EndIf
  If duplicate <> ""
    ConsoleColor(7, 0)
    Print("Warning: duplicate rule definition: ") : PrintN(duplicate)
    ConsoleColor(2, 0)
  EndIf  
  ProcedureReturn perr 
new55:
  If duplicate <> ""
    ConsoleColor(7, 0)
    Print("Warning: duplicate rule definition: ") : PrintN(duplicate)
    ConsoleColor(2, 0)
  EndIf  
  ProcedureReturn perr 
EndProcedure

Procedure.i entry()
  Protected  perr.i
  perr = elem()
  If perr < 0  
    ProcedureReturn perr 
  EndIf
 MetaPi11:
 If perr < 0  
   Goto MetaPi12
  EndIf
  perr = elem2()
  Goto MetaPi11
 MetaPi12:
  perr = 1
  SEM6()
  ProcedureReturn perr
EndProcedure

Procedure.i elem()
  Protected  perr.i
  perr = typ1()
  If perr < 0
   Goto MetaPi14
  EndIf
  perr = SEM8()
  ProcedureReturn perr
  MetaPi14:
  perr = typ2()
  If perr < 0
   Goto MetaPi15
  EndIf
  perr = SEM2()
  ProcedureReturn perr
  MetaPi15:
  perr = prim()
  If perr < 0 
    ProcedureReturn perr
   EndIf
  SEM8()
  ProcedureReturn perr
EndProcedure

Procedure.i elem2()
  Protected  perr.i
  perr = typ1()
  If perr < 0
   Goto MetaPi17
  EndIf
  ProcedureReturn perr
  MetaPi17:
  perr = typ2()
  If perr < 0
   Goto MetaPi18
  EndIf
  SEM5()
  ProcedureReturn 0
  MetaPi18:
  perr = prim()
  ProcedureReturn perr
EndProcedure

Procedure.i typ1()
  Protected  perr.i
  perr = codes()
  If perr < 0
   Goto NEW22
  EndIf
  ProcedureReturn perr
  NEW22:
  perr = too()
  If perr < 0
   Goto NEW23
  EndIf
  ProcedureReturn perr
  NEW23:
  perr = recurs()
  If perr < 0
   Goto NEW24
  EndIf
  ProcedureReturn perr
  NEW24:
  perr = getcode()
  If perr < 0
   Goto NEW25
  EndIf
  ProcedureReturn perr
  NEW25:
  perr = NEXTs()
  If perr < 0
   Goto NEW26
  EndIf
  ProcedureReturn perr
  NEW26:
  perr = snm()
  If perr < 0
   Goto NEW27
  EndIf
  ProcedureReturn perr
  NEW27:
  perr = labels()
  If perr < 0
   Goto NEW28
  EndIf
  ProcedureReturn perr
  NEW28:
  perr = look()
  If perr < 0
   Goto NEW29
  EndIf
  ProcedureReturn perr
  NEW29:
  perr = zero()
  If perr < 0
   Goto NEW30
  EndIf
  ProcedureReturn perr
  NEW30:
  ProcedureReturn perr
EndProcedure

Procedure.i typ2() 
  Protected  perr.i
  perr = expr()
  If perr < 0
    Goto NEWS28
  EndIf
  ProcedureReturn perr
  NEWS28:
  perr = GETANID()
  If perr < 0
    Goto NEWS29
  EndIf
  SEM10()
  ProcedureReturn perr
  NEWS29:
  perr = GETSTRING()
  If perr < 0
    Goto NEWS30
  EndIf
  SEM11()
  ProcedureReturn perr
  NEWS30:
  perr = TESTTOKEN(".ID")
  If perr < 0
    Goto NEWS31
  EndIf
  SEM20()
  perr = TESTTOKEN(":")
  If perr < 0
    Goto NEWS33
  EndIf
  perr = GETANID()
  If perr < 0
    Goto NEWS33
  EndIf
  SEM30()
  NEWS33:
  If perr > 0  
    Goto NEWS32
  EndIf
  perr = 1
  NEWS32:
  If perr < 0
     Goto NEWS31
  EndIf
  POPSTACK(3) 
  ProcedureReturn perr
  NEWS31:
  perr = TESTTOKEN(".INT")
  If perr < 0
     Goto NEWS35
  EndIf
  SEM21()
  perr = TESTTOKEN(":")
  If perr < 0
     Goto NEWS37
  EndIf
  perr = GETANID()
  If perr < 0
     Goto NEWS37
  EndIf
  SEM30()
  NEWS37:
  If perr > 0  
    Goto NEWS36
  EndIf
  perr = 1
  NEWS36:
  If perr < 0
     Goto NEWS35
  EndIf
  POPSTACK(3) 
  ProcedureReturn perr
  NEWS35:
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  perr = TESTTOKEN(".REAL")
  If perr < 0
     Goto NEWS391
  EndIf
  SEM22a()
  perr = TESTTOKEN(":")
  If perr < 0
     Goto NEWS411
  EndIf
  perr = GETANID()
  If perr < 0
     Goto NEWS411
  EndIf
  SEM30()
  NEWS411:
  ProcedureReturn perr
  NEWS391:
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  perr = TESTTOKEN(".GETSTRING")
  If perr < 0
     Goto NEWS39
  EndIf
  SEM22()
  perr = TESTTOKEN(":")
  If perr < 0
     Goto NEWS41
  EndIf
  perr = GETANID()
  If perr < 0
     Goto NEWS41
  EndIf
  SEM30()
  NEWS41:
  If perr > 0  
    Goto NEWS40
  EndIf
  perr = 1
  NEWS40:
  If perr < 0
     Goto NEWS39
  EndIf
  POPSTACK(3) 
  ProcedureReturn perr
  NEWS39:
  perr = TESTTOKEN(".LABEL(")
  If perr < 0
     Goto NEWS43
  EndIf
  SEM25()
  ProcedureReturn perr
  NEWS43:
  ProcedureReturn perr
EndProcedure

Procedure.i expr()
  Protected  perr.i
  perr = TESTTOKEN("(")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  SEM23()
  perr = elemxp()
  If perr < 0 
    ProcedureReturn perr
  EndIf
  perr = TESTTOKEN(")")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  SEM7()
EndProcedure

Procedure.i elemxp()
  Protected  perr.i
  perr = entry2()
  If perr < 0 
    ProcedureReturn perr
  EndIf
  MetaPi35:
  If perr < 0
    Goto  MetaPi36
  EndIf
  perr = TESTTOKEN("|")
  If perr < 0
    Goto  MetaPi39
  EndIf
  SEM3()
  perr = entry2()
  MetaPi39:
   Goto MetaPi35
  MetaPi36:
  perr = 1
  ProcedureReturn perr
EndProcedure

Procedure.i entry2()
  Protected  perr.i
  perr = elem()
  If perr < 0 
    ProcedureReturn perr
  EndIf
  MetaPi41:
  If perr < 0
    Goto  MetaPi42
  EndIf
  perr = elem2()
  Goto MetaPi41
  MetaPi42:
  perr = 1
  SEM7()
  ProcedureReturn perr
EndProcedure

Procedure.i too()
  Protected  perr.i
  perr = TESTTOKEN(".SYNC2")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  perr = TESTTOKEN("(")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  perr = GETSTRING()
  EMIT("  SYNCTO(")
  EMIT("", #FROMOUT)
  EMIT(");")
  perr = TESTTOKEN(")")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i zero()
  Protected  perr.i
  perr = TESTTOKEN("{")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  SEM23()
  perr = elemxp()
  If perr < 0
    Goto  NEWS54
  EndIf
  NEWS54:
  If perr > 0  
    Goto  NEWS53
  EndIf
  perr = 1
  NEWS53:
  perr = TESTTOKEN("}")
  If perr < 0
    Goto  NEWS52
  EndIf
  SEM27()
  ProcedureReturn perr
  NEWS52:
  ProcedureReturn perr
EndProcedure

Procedure.i codes()
  Protected  perr.i
  perr = TESTTOKEN("@@")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  FLUSH()
  EMIT("; START OF USER CODE")
  FLUSH()
  perr = DOCODES("@@")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  EMIT("; END   OF USER CODE")
  FLUSH()
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i getcode()
  Protected  perr.i
  perr = TESTTOKEN(".COLLECT2")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  perr = TESTTOKEN("(")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  perr = GETSTRING()
  EMIT("  COLLECTTO(@inputline, @tok, ")
  EMIT("", #FROMOUT)
  perr = TESTTOKEN(")")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  EMIT(");")
  FLUSH()
  EMIT("  if perr < 0")
  FLUSH()
  EMIT("    ProcedureReturn perr")
  FLUSH()
  EMIT("  endif")
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i recurs()
  Protected  perr.i
  perr = TESTTOKEN("$")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  SEM14()
  perr = elem()
  If perr < 0 
    ProcedureReturn perr
  EndIf
  SEM15()
  ProcedureReturn perr
EndProcedure

Procedure.i look()
  Protected  perr.i
  perr = TESTTOKEN("?")
  If perr < 0
    Goto  NEWS49
  EndIf
  SEM26()
  perr = elem()
  If perr < 0
    Goto NEWS49
  EndIf
  SEM16()
  ProcedureReturn perr
  NEWS49:
  ProcedureReturn perr
EndProcedure

Procedure.i lookzero()
  Protected  perr.i
  perr = TESTTOKEN("?[")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  SEM26()
  SEM23()
  perr = elemxp()
  If perr < 0
    Goto  NEWS54
  EndIf
  NEWS54:
  If perr > 0  
    Goto  NEWS53
  EndIf
  perr = 1
  NEWS53:
  perr = TESTTOKEN("]")
  If perr < 0
    Goto  NEWS52
  EndIf
  SEM16()
  SEM27()
  ProcedureReturn perr
  NEWS52:
  SEM16()
  ProcedureReturn perr
EndProcedure

Procedure.i errtext()
  Protected  perr.i
  perr = TESTTOKEN("<<")
  If perr < 0
    Goto  NEWSs49
  EndIf
  perr = GETSTRING()
  If perr < 0
    Goto NEWSs49
  EndIf
  SEM9()
  perr = TESTTOKEN(",")
  If perr < 0
    Goto NEWSs48
  EndIf
  perr = GETSTRING()
  SEM19()
  If perr < 0
    Goto NEWSs49
  EndIf
  NEWSs48:
  perr = TESTTOKEN(">>")
  ProcedureReturn perr
  NEWSs49:
  ProcedureReturn perr
EndProcedure

Procedure.i nexts()
  Protected  perr.i
  perr = TESTTOKEN(".FLUSH")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  SEM18()
  ProcedureReturn 1
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i callheader()
  Protected perr.i = 0
  perr = TESTTOKEN("@")
  If perr < 0
    Goto prim74
  EndIf
  SEM13()
prim74: 
  perr = 1
prim73:
  perr = GETANID()
  If perr < 0
    Goto prim77
  EndIf
prim77: 
  If perr > 0
    Goto prim76
  EndIf
  perr = GETINT()
  If perr < 0
    Goto prim78
  EndIf
prim78: 
  If perr > 0
    Goto prim76
  EndIf
  perr = GETSTRING()
  If perr < 0
    Goto prim79
  EndIf
prim79: 
prim76: 
  If perr < 0
    Goto prim75
  EndIf
  SEM13()
prim80:
  If perr < 0
    Goto prim81
  EndIf
  perr = TESTTOKEN(",")
  If perr < 0
    Goto prim83
  EndIf
  perr = TESTTOKEN("@")
  If perr < 0
    Goto prim85
  EndIf
  SEM13()
prim85: 
  perr = 1
prim84:
  SEM13()
  perr = GETANID()
  If perr < 0
    Goto prim87
  EndIf
prim87: 
  If perr > 0
    Goto prim86
  EndIf
  perr = GETINT()
  If perr < 0
    Goto prim88
  EndIf
prim88: 
  If perr > 0
    Goto prim86
  EndIf
  perr = GETSTRING()
  If perr < 0
    Goto prim89
  EndIf
prim89: 
prim86: 
  If perr < 0
    Goto prim83
  EndIf
  SEM13()
prim83: 
prim82: 
  If perr < 0
    Goto prim90
  EndIf
prim90: 
  Goto prim80
prim81:
  perr = 1
  ProcedureReturn perr 
prim75:
  ProcedureReturn perr 
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i prim()
  Protected perr.i = 0
  perr = TESTTOKEN(".")
  If perr < 0
    Goto prim91
  EndIf
  perr = GETANID()
  If perr < 0
    Goto prim91
  EndIf
  SEM17()
  perr = TESTTOKEN("(")
  If perr < 0
    Goto prim93
  EndIf
  SEM13()
  perr = callheader()
  If perr < 0
    Goto prim93
  EndIf
prim94:
  If perr < 0
    Goto prim95
  EndIf
  perr = TESTTOKEN(",")
  If perr < 0
    Goto prim97
  EndIf
  SEM13()
  perr = callheader()
  If perr < 0
    Goto prim97
  EndIf
prim97: 
prim96: 
  If perr < 0
    Goto prim98
  EndIf
prim98: 
  Goto prim94
prim95:
  perr = 1
  perr = TESTTOKEN(")")
  If perr < 0
    Goto prim93
  EndIf
  SEM12()
prim93: 
  If perr > 0
    Goto prim92
  EndIf
  perr = 1
prim92: 
  If perr < 0
    Goto prim91
  EndIf
  ProcedureReturn perr 
prim91:
  ProcedureReturn perr 
EndProcedure

Procedure.i snm()
  Protected  perr.i
  perr = TESTTOKEN("SEM")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  EMIT("  ")
  EMIT("",#FROMOUT)
  perr = GETINT()
  If perr > 0  
    Goto  NEWS87
  EndIf
  perr = TESTTOKEN("_")
  If perr < 0  
    Goto  NEWS87
  EndIf
  EMIT("",#FROMOUT)
  perr = GETANID()
  NEWS87:
  If perr < 0 
    ProcedureReturn perr
  EndIf
  EMIT("",#FROMOUT)
  EMIT("()")
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i labels()
  Protected  perr.i
  perr = TESTTOKEN(".LABEL(")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  EMIT("  LABEL(")
  perr = GETANID()
  EMIT("", #FROMOUT)
  perr = TESTTOKEN(",")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  EMIT(",")
  perr = GETANID()
  EMIT("", #FROMOUT)
  perr = TESTTOKEN(")")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  EMIT(")")
  FLUSH()
  ProcedureReturn perr
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Procedure.i SEM1()
  Protected  perr.i = 0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM1")
  EndIf
  EMIT(";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")
  FLUSH()
  EMIT("Procedure.i ")
  EMIT("", #FROMOUT)
  prototypestring = scanner\token\token + "()"
  duplicate = FindDuplicateRulenames(prototypestring)
  meta_scanner::prototypes(scanner\token\token) = prototypestring ; scanner\token\token + "()"
  EMIT("()")
  FLUSH()
  EMIT("  Protected perr.i = 0")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM1")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM_a1()
  Protected  perr.i = 0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM1")
  EndIf
  prototypestring = prototypestring + scanner\token\token
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM1")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM_b1()
  Protected  perr.i = 0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM1")
  EndIf
  EMIT(";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")
  FLUSH()
  duplicate = FindDuplicateRulenames(prototypestring)
  meta_scanner::prototypes(prototypestring) = prototypestring
  EMIT("Procedure.i ")
  EMIT(prototypestring)
  FLUSH()
  EMIT("  Protected perr.i = 0")
  FLUSH()
  prototypestring = ""
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM1")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM2()
  Protected  perr.i = 0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM2")
  EndIf
  EMIT("  IF perr < 0")
  FLUSH()
  EMIT("    GOTO ")
  DOLABEL(#DOESNEW, #DOESOUT)
  FLUSH()
  EMIT("  EndIf")
  FLUSH()
  DOLABEL(#DOESPREVIOUS, #DOESSAVE)
  STACKS(#FROMSAVE)
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM2")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM3()
  Protected  perr.i = 0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM3")
  EndIf
  EMIT("  IF perr > 0")
  FLUSH()
  EMIT("    Goto ")
  PEEPSTACK()
  EMIT("", #FROMOUT)
  FLUSH()
  EMIT("  EndIf")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM3")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM4()
  Protected  perr.i = 0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM4")
  EndIf
  prototypestring = "" 
  EMIT("  ProcedureReturn perr ")
  FLUSH()
  EMIT("EndProcedure")
  FLUSH()
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM4")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM5()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM5")
  EndIf
  EMIT("  IF perr < 0")
  FLUSH()
  EMIT("    GOTO ")
  PEEPSTACK()
  EMIT("", #FROMOUT)
  FLUSH()
  EMIT("  EndIf"); , #FROMOUT)
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM5")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM6()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM6")
  EndIf
  EMIT("  ProcedureReturn perr ")
  FLUSH()
  POPSTACK()
  EMIT("", #FROMOUT)
  EMIT(":")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM6")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM7()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM7")
  EndIf
  POPSTACK()
  EMIT("", #FROMOUT)
  EMIT(": ")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM7")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM8()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM8")
  EndIf
  DOLABEL(#DOESNEW, #DOESSAVE)
  STACKS(#FROMSAVE)
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM8")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM9()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM9")
  EndIf
  EMIT("  ErrorText = ")
  EMIT("", #FROMOUT)
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM9")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM10()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM10")
  EndIf
  EMIT("  perr = ")
  EMIT("", #FROMOUT)
  EMIT("()")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM10")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM11()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM11")
  EndIf
  EMIT("  perr = TESTTOKEN(@inputline, @tok, ")
  EMIT("", #FROMOUT)
  EMIT(")")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM11")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM12()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM12")
  EndIf
  EMIT("", #FROMOUT)
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM12")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM13()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM13")
  EndIf
  EMIT("", #FROMOUT)
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM13")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM14()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM14")
  EndIf
  DOLABEL(#DOESNEW, #DOESOUT)
  EMIT(":")
  FLUSH()
  DOLABEL(#DOESPREVIOUS, #DOESSAVE)
  STACKS(#FROMSAVE)
  EMIT("  IF perr < 0")
  FLUSH()
  EMIT("    GOTO ")
  DOLABEL(#DOESNEW, #DOESOUT)
  FLUSH()
  EMIT("  EndIf")
  FLUSH()
  DOLABEL(#DOESPREVIOUS, #DOESSAVE)
  STACKS(#FROMSAVE)
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM14")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM15()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM15")
  EndIf
  POPSTACK()
  EMIT("", #FROMOUT)
  EMIT(": ")
  FLUSH()
  EMIT("  GOTO ")
  POPSTACK()
  SAVETEMP()
  POPSTACK()
  EMIT("", #FROMOUT)
  ;EMIT(":")
  FLUSH()
  STACKS(#FROMSAVE)
  POPSTACK()
  EMIT("", #FROMOUT)
  EMIT(":")
  FLUSH()
  EMIT("  perr = 1")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM15")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM16()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM16")
  EndIf
  FLUSH()
  POPSTACK()
  EMIT("", #FROMOUT)
  EMIT(": ")
  FLUSH()
  EMIT("  CopyScannerStructure(@scanner, @tmpscanner)")
  FLUSH()    
  EMIT("  FileSeek(scanner\currentFile, scanner\fileposition)")
  FLUSH()
  EMIT("  if perr < 0")
  FLUSH()
  EMIT("    ProcedureReturn perr")
  FLUSH()
  EMIT("  endif")
  FLUSH()
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM16")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM17() ;;;; . and ID
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM17")
  EndIf
  EMIT("  perr = ")
  EMIT("", #FROMOUT)
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM17")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM17a() ;;;; . and ID
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM17")
  EndIf
  EMIT(")")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM17")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM18()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM18")
  EndIf
  EMIT("  FLUSH()")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM18")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM19()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM19")
  EndIf
  EMIT("  SyncText = ")
  EMIT("", #FROMOUT)
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM19")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM20()
  Protected  perr.i=0
  EMIT("  perr = GETANID(@inputline, @tok)")
  STACKS(#FROMTOKEN, "",#id, 3)
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i SEM21()
  Protected  perr.i=0
  EMIT("  perr = GETINT(@inputline, @tok)")
  STACKS(#FROMTOKEN, "",#integer, 3)
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i SEM22()
  Protected  perr.i=0
  EMIT("  perr = GETSTRING(@inputline, @tok)")
  STACKS(#FROMTOKEN, "",#string, 3)
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i SEM22a()
  Protected  perr.i=0
  EMIT("  perr = GETREAL(@inputline, @tok)")
  STACKS(#FROMTOKEN, "",#float, 3)
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i SEM23()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM23")
  EndIf
  DOLABEL(#DOESNEW, #DOESSAVE)
  STACKS(#FROMSAVE)
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM23")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM25()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM25")
  EndIf
  EMIT("  LABEL(")
  perr = GETANID()
  EMIT("", #FROMOUT)
  perr = TESTTOKEN(",")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  EMIT(",")
  perr = GETANID()
  EMIT("", #FROMOUT)
  perr = TESTTOKEN(")")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  EMIT(")")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM25")
  EndIf
EndProcedure

Procedure.i SEM26()
  Protected  perr.i=0
  EMIT("  CopyScannerStructure(@tmpscanner, @scanner)")
  FLUSH()
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i SEM27()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM27")
  EndIf
  EMIT("  perr = 1")
  FLUSH()
  POPSTACK()
  EMIT("", #FROMOUT)
  EMIT(":")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM27")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM30()
  Protected  perr.i=0
  EMIT("  Protected ")
  STACKS(#FROMTOKEN, "",#none, 1)
  POPSTACK(1)
  EMIT("", #FROMOUT)
  PEEPSTACK(3)
  Select scanner\token\tokentype
    Case #none, #string
      EMIT(".s")
    Case #integer
      EMIT(".i")
    Case #float
      EMIT(".d")
    Case #id
      EMIT(".s")
    Case #anychar
      EMIT(".c")
    Case #code
      EMIT(".s")
    Case #collect
      EMIT(".s")
  EndSelect   
  EMIT(" = ")
  POPSTACK(3)
  Select scanner\token\tokentype
    Case #none
      EMIT(" scanner\token\token")
    Case #string
      EMIT("chr(34)+") : EMIT("scanner\token\token") : EMIT("+chr(34)")
    Case #integer
      EMIT(" val(scanner\token\token)")
    Case #float
      EMIT(" vald(scanner\token\token)")
    Case #id
      EMIT(" scanner\token\token")
    Case #anychar
      EMIT(" scanner\token\token")
    Case #code
      EMIT(" scanner\token\token")
    Case #collect
      EMIT(" scanner\token\token")
  EndSelect     
  FLUSH()
  ProcedureReturn perr
EndProcedure

Global.s outfil1,outfil, ins

Procedure CREATES(in.s, out.s)
  outfil1=out
  outfil=out
  scanner\fileinputchannel  = OpenFile(#PB_Any, in, #PB_File_SharedRead )
  scanner\fileoutputchannel = CreateFile(#PB_Any, out+".tmp")
  meta_scanner::protoypeFile= out
  scanner\largestColumn     = 0
  scanner\labelnumber       = 0
  scanner\libInProgress     = 0
  scanner\currentFile       = scanner\fileinputchannel
  scanner\mainInputFile     = scanner\fileinputchannel
  scanner\fileposition      = Loc(scanner\fileinputchannel)
  scanner\doingCode         = #False
  scanner\doingTrace        = #False
  scanner\doingToScreen     = #True
  scanner\mainIsSet         = #False
  scanner\LabelName         = "METAPI"
  scanner\DEBUGS            = #False
  scanner\token\tokentype   = #none
  scanner\token\token       = ""
  Protected i.i
  For i = 0 To #MAXSTACKS
    scanner\stackpointer(i) = 0
  Next
  meta_scanner::protoypeFile = GetFilePart(meta_scanner::protoypeFile, #PB_FileSystem_NoExtension)    
EndProcedure

OpenConsole("MetaPi Compiler @RKO")
ConsoleColor(2, 0)
ins = ProgramParameter()
outfil = ProgramParameter()
If Len(Trim(ins)) <= 0
  PrintN("Meta Input File Missing")
  PrintN("")
  ConsoleColor(14, 0)
  PrintN("Call Metacompiler with:")
  PrintN("infilename")
  PrintN("optinal outfilename")
  PrintN("")
  ConsoleColor(2, 0)
  PrintN("Hit Enter to end the program")
  Input()
  CloseConsole()
  End
EndIf
If Len(Trim(outfil)) <= 0
  ConsoleColor(14, 0)
  PrintN("Ouput File Missing - assuming as name:  metaout.pb")
  ConsoleColor(2, 0)
  outfil = "metaout.pb"
Else
  If Len(GetExtensionPart(outfil)) <= 0
    outfil+".pb"
  EndIf
EndIf
CREATES(ins, outfil)
prog()
If scanner\mainName <> ""
  ;meta_scanner::prototypes(scanner\token\token) = scanner\mainName
  WriteStringN(scanner\fileoutputchannel, "")
  WriteStringN(scanner\fileoutputchannel, ";;;;;;;;;;;;; MAIN to call")
  If FindString(scanner\mainName, "(") 
    WriteStringN(scanner\fileoutputchannel, scanner\mainName)
  Else
    WriteStringN(scanner\fileoutputchannel, scanner\mainName+"()")
  EndIf
EndIf
;WriteScanner()
CloseFile(scanner\fileoutputchannel)
outfil1 = meta_scanner::protoypeFile + "_inc.pbi"
scanner\fileoutputchannel = CreateFile(#PB_Any, outfil1)
;WriteStringN(scanner\fileoutputchannel, "; Created with: MetaPi Compiler @RKO 2015")
;WriteStringN(scanner\fileoutputchannel, "")
WriteStringN(scanner\fileoutputchannel, "")
WriteStringN(scanner\fileoutputchannel, ";;;;;;;;;;;;;; Minimal Scanner ;;;;;;;;;;;;;;;;")
WriteStringN(scanner\fileoutputchannel, "")
WriteScanner()
WriteStringN(scanner\fileoutputchannel, "")
WriteStringN(scanner\fileoutputchannel, "")
WriteStringN(scanner\fileoutputchannel, ";;;;;;;;;;;;;; Parser Declares ;;;;;;;;;;;;;;;;")
ResetMap(meta_scanner::prototypes())
While NextMapElement(meta_scanner::prototypes())
  WriteStringN(scanner\fileoutputchannel, "Declare.i " + meta_scanner::prototypes())
Wend
CloseFile(scanner\fileoutputchannel)
scanner\fileoutputchannel = CreateFile(#PB_Any, outfil)
scanner\fileinputchannel  = OpenFile(#PB_Any, outfil1, #PB_File_SharedRead )
WriteStringN(scanner\fileoutputchannel, "; Created with: MetaPi Compiler @RKO 2015")
WriteStringN(scanner\fileoutputchannel, "")
While Eof(scanner\fileinputchannel) = 0  
  WriteStringN(scanner\fileoutputchannel, ReadString(scanner\fileinputchannel))
Wend
CloseFile(scanner\fileinputchannel)
scanner\fileinputchannel  = OpenFile(#PB_Any, outfil+".tmp", #PB_File_SharedRead )
While Eof(scanner\fileinputchannel) = 0  
  WriteStringN(scanner\fileoutputchannel, ReadString(scanner\fileinputchannel))
Wend
CloseFile(scanner\fileinputchannel)
CloseFile(scanner\fileoutputchannel)
DeleteFile(outfil+".tmp", #PB_FileSystem_Force)
DeleteFile(outfil1, #PB_FileSystem_Force)
FreeMap(prototypes())
Input()
CloseConsole()
Top
startup
Enthusiast
Enthusiast
Posts: 105
Joined: Wed Feb 25, 2015 5:55 pm

Re: meta pi compiler compiler

Post by startup »

please insert this code in part 1 at: ;;;;;;;; insert part 2 HERE

Code: Select all

Procedure WriteScanner()
  Protected pline.s = ""
  WriteStringN(scanner\fileoutputchannel, "Structure token")
  WriteStringN(scanner\fileoutputchannel, "  token.s")
  WriteStringN(scanner\fileoutputchannel, "  tokentype.i")
  WriteStringN(scanner\fileoutputchannel, "EndStructure ")
  WriteStringN(scanner\fileoutputchannel, " ")
  WriteStringN(scanner\fileoutputchannel, "Enumeration toktype")
  WriteStringN(scanner\fileoutputchannel, "  #none")
  WriteStringN(scanner\fileoutputchannel, "  #string")
  WriteStringN(scanner\fileoutputchannel, "  #integer ")
  WriteStringN(scanner\fileoutputchannel, "  #float ")
  WriteStringN(scanner\fileoutputchannel, "  #id")
  WriteStringN(scanner\fileoutputchannel, "  #anychar ")
  WriteStringN(scanner\fileoutputchannel, "  #code")
  WriteStringN(scanner\fileoutputchannel, "  #collect ")
  WriteStringN(scanner\fileoutputchannel, "EndEnumeration ")
  WriteStringN(scanner\fileoutputchannel, " ")
  WriteStringN(scanner\fileoutputchannel, " ")
  WriteStringN(scanner\fileoutputchannel, "Procedure ClearToken(*tok.token) ")
  WriteStringN(scanner\fileoutputchannel, "  *tok\token = "+Chr(34)+Chr(34))
  WriteStringN(scanner\fileoutputchannel, "  *tok\tokentype = #none ")
  WriteStringN(scanner\fileoutputchannel, "EndProcedure ")
  WriteStringN(scanner\fileoutputchannel, " ")
  WriteStringN(scanner\fileoutputchannel, "Procedure.i IsDigit(char.s)")
  WriteStringN(scanner\fileoutputchannel, "  Select Asc(char) ")
  WriteStringN(scanner\fileoutputchannel, "    Case 48 To 57, 46")
  WriteStringN(scanner\fileoutputchannel, "      ProcedureReturn #True")
  WriteStringN(scanner\fileoutputchannel, "    Default")
  WriteStringN(scanner\fileoutputchannel, "      ProcedureReturn #False ")
  WriteStringN(scanner\fileoutputchannel, "  EndSelect")
  WriteStringN(scanner\fileoutputchannel, "EndProcedure ")
  WriteStringN(scanner\fileoutputchannel, " ")
  WriteStringN(scanner\fileoutputchannel, "Procedure.i GETINT(*inputline.string, *tok.token)")
  WriteStringN(scanner\fileoutputchannel, "  If *inputline\s ="+Chr(34)+Chr(34))
  WriteStringN(scanner\fileoutputchannel, "    ProcedureReturn -100 ")
  WriteStringN(scanner\fileoutputchannel, "  EndIf")
  WriteStringN(scanner\fileoutputchannel, "  Select Asc(Mid(*inputline\s, 1, 1))")
  WriteStringN(scanner\fileoutputchannel, "    Case 48 To 57")
  WriteStringN(scanner\fileoutputchannel, "    Default")
  WriteStringN(scanner\fileoutputchannel, "      ProcedureReturn -99")
  WriteStringN(scanner\fileoutputchannel, "  EndSelect")
  WriteStringN(scanner\fileoutputchannel, "  *tok\token = "+Chr(34)+Chr(34))
  WriteStringN(scanner\fileoutputchannel, "  Protected counter.l = 1")
  WriteStringN(scanner\fileoutputchannel, "  While Mid(*inputline\s, counter, 1) <> #CRLF$")
  WriteStringN(scanner\fileoutputchannel, "    Select Asc(Mid(*inputline\s, counter, 1))")
  WriteStringN(scanner\fileoutputchannel, "      Case 48 To 57")
  WriteStringN(scanner\fileoutputchannel, "        *tok\token = *tok\token + Mid(*inputline\s, counter, 1)")
  WriteStringN(scanner\fileoutputchannel, "        counter + 1")
  WriteStringN(scanner\fileoutputchannel, "      Default")
  WriteStringN(scanner\fileoutputchannel, "        *inputline\s = Mid(*inputline\s, counter, Len(*inputline\s)) ")
  WriteStringN(scanner\fileoutputchannel, "        *tok\tokentype = #integer")
  WriteStringN(scanner\fileoutputchannel, "        ProcedureReturn counter-1")
  WriteStringN(scanner\fileoutputchannel, "    EndSelect")
  WriteStringN(scanner\fileoutputchannel, "  Wend ")
  WriteStringN(scanner\fileoutputchannel, "  *tok\tokentype = #none ")
  WriteStringN(scanner\fileoutputchannel, "EndProcedure ")
  WriteStringN(scanner\fileoutputchannel, " ")
  WriteStringN(scanner\fileoutputchannel, "Procedure.i GETANID(*inputline.string, *tok.token) ")
  WriteStringN(scanner\fileoutputchannel, "  If *inputline\s = "+Chr(34)+Chr(34))
  WriteStringN(scanner\fileoutputchannel, "    ProcedureReturn -100 ")
  WriteStringN(scanner\fileoutputchannel, "  EndIf")
  WriteStringN(scanner\fileoutputchannel, "  Select Asc(Mid(*inputline\s, 1, 1))")
  WriteStringN(scanner\fileoutputchannel, "    Case 65 To 90, 97 To 122, 95 ")
  WriteStringN(scanner\fileoutputchannel, "    Default")
  WriteStringN(scanner\fileoutputchannel, "      ProcedureReturn - -98")
  WriteStringN(scanner\fileoutputchannel, "  EndSelect")
  WriteStringN(scanner\fileoutputchannel, "  *tok\token = "+Chr(34)+Chr(34))
  WriteStringN(scanner\fileoutputchannel, "  Protected counter.i = 1")
  WriteStringN(scanner\fileoutputchannel, "  While Mid(*inputline\s, counter, 1) <> #CRLF$")
  WriteStringN(scanner\fileoutputchannel, "    Select Asc(Mid(*inputline\s, counter, 1))")
  WriteStringN(scanner\fileoutputchannel, "      Case 65 To 90, 97 To 122, 48 To 57, 95 ")
  WriteStringN(scanner\fileoutputchannel, "        *tok\token = *tok\token + Mid(*inputline\s, counter, 1)")
  WriteStringN(scanner\fileoutputchannel, "        counter + 1")
  WriteStringN(scanner\fileoutputchannel, "      Default")
  WriteStringN(scanner\fileoutputchannel, "        *inputline\s = Mid(*inputline\s, counter, Len(*inputline\s)) ")
  WriteStringN(scanner\fileoutputchannel, "        *tok\tokentype = #id ")
  WriteStringN(scanner\fileoutputchannel, "        ProcedureReturn counter - 1")
  WriteStringN(scanner\fileoutputchannel, "        Break")
  WriteStringN(scanner\fileoutputchannel, "    EndSelect")
  WriteStringN(scanner\fileoutputchannel, "  Wend ")
  WriteStringN(scanner\fileoutputchannel, "  *tok\tokentype = #none ")
  WriteStringN(scanner\fileoutputchannel, "EndProcedure ")
  WriteStringN(scanner\fileoutputchannel, " ")
  WriteStringN(scanner\fileoutputchannel, "Procedure.i GETREAL(*inputline.string, *tok.token) ")
  WriteStringN(scanner\fileoutputchannel, "  Protected counter.l = 1")
  WriteStringN(scanner\fileoutputchannel, "  Protected matchPosition.l")
  WriteStringN(scanner\fileoutputchannel, "  If *inputline\s = "+Chr(34)+Chr(34))
  WriteStringN(scanner\fileoutputchannel, "    ProcedureReturn -100 ")
  WriteStringN(scanner\fileoutputchannel, "  EndIf")
  WriteStringN(scanner\fileoutputchannel, "  Select Asc(Mid(*inputline\s, 1, 1))")
  WriteStringN(scanner\fileoutputchannel, "    Case Asc("+Chr(34)+"0"+Chr(34)+") To Asc("+Chr(34)+"9"+Chr(34)+")")
  WriteStringN(scanner\fileoutputchannel, "      counter = 1")
  WriteStringN(scanner\fileoutputchannel, "    Case Asc("+Chr(34)+"."+Chr(34)+")")
  WriteStringN(scanner\fileoutputchannel, "      If IsDigit(Mid(*inputline\s, 1, 1))")
  WriteStringN(scanner\fileoutputchannel, "        counter = 2")
  WriteStringN(scanner\fileoutputchannel, "      Else ")
  WriteStringN(scanner\fileoutputchannel, "        ProcedureReturn -97")
  WriteStringN(scanner\fileoutputchannel, "      EndIf")
  WriteStringN(scanner\fileoutputchannel, "    Default")
  WriteStringN(scanner\fileoutputchannel, "      ProcedureReturn -97")
  WriteStringN(scanner\fileoutputchannel, "  EndSelect")
  WriteStringN(scanner\fileoutputchannel, "  While Mid(*inputline\s, counter, 1) <> #CRLF$")
  WriteStringN(scanner\fileoutputchannel, "    Select  Asc(Mid(*inputline\s, counter, 1)) ")
  WriteStringN(scanner\fileoutputchannel, "      Case Asc("+Chr(34)+"0"+Chr(34)+") To Asc("+Chr(34)+"9"+Chr(34)+")")
  WriteStringN(scanner\fileoutputchannel, "        *tok\token = *tok\token + Mid(*inputline\s, counter, 1)")
  WriteStringN(scanner\fileoutputchannel, "        counter + 1")
  WriteStringN(scanner\fileoutputchannel, "      Default")
  WriteStringN(scanner\fileoutputchannel, "        counter - 1")
  WriteStringN(scanner\fileoutputchannel, "        Break")
  WriteStringN(scanner\fileoutputchannel, "    EndSelect")
  WriteStringN(scanner\fileoutputchannel, "  Wend ")
  WriteStringN(scanner\fileoutputchannel, "  If Mid(*inputline\s, counter, 1) <> #CRLF$ ")
  WriteStringN(scanner\fileoutputchannel, "    If Mid(*inputline\s, counter+1, 1) = "+Chr(34)+"E"+Chr(34)+" Or Mid(*inputline\s, counter, 1) = "+Chr(34)+"e"+Chr(34)+"")
  WriteStringN(scanner\fileoutputchannel, "      If Mid(*inputline\s, counter+2, 1) = "+Chr(34)+"+"+Chr(34)+" Or Mid(*inputline\s, counter, 1) = "+Chr(34)+"-"+Chr(34)+"")
  WriteStringN(scanner\fileoutputchannel, "        counter + 2")
  WriteStringN(scanner\fileoutputchannel, "        *tok\token = *tok\token + Mid(*inputline\s, counter, 1)")
  WriteStringN(scanner\fileoutputchannel, "      Else ")
  WriteStringN(scanner\fileoutputchannel, "        counter + 1")
  WriteStringN(scanner\fileoutputchannel, "      EndIf")
  WriteStringN(scanner\fileoutputchannel, "      While Mid(*inputline\s, counter, 1) <> #CRLF$")
  WriteStringN(scanner\fileoutputchannel, "        Select  Asc(Mid(*inputline\s, counter, 1)) ")
  WriteStringN(scanner\fileoutputchannel, "          Case Asc("+Chr(34)+"0"+Chr(34)+") To Asc("+Chr(34)+"9"+Chr(34)+")")
  WriteStringN(scanner\fileoutputchannel, "            *tok\token = *tok\token + Mid(*inputline\s, counter, 1)")
  WriteStringN(scanner\fileoutputchannel, "            counter + 1")
  WriteStringN(scanner\fileoutputchannel, "          Default")
  WriteStringN(scanner\fileoutputchannel, "            counter - 1")
  WriteStringN(scanner\fileoutputchannel, "            Break")
  WriteStringN(scanner\fileoutputchannel, "        EndSelect")
  WriteStringN(scanner\fileoutputchannel, "      Wend ")
  WriteStringN(scanner\fileoutputchannel, "    EndIf")
  WriteStringN(scanner\fileoutputchannel, "  EndIf")
  WriteStringN(scanner\fileoutputchannel, "  *tok\token = Mid(*inputline\s, 1, counter) ")
  WriteStringN(scanner\fileoutputchannel, "  *inputline\s = Mid(*inputline\s, counter+1, Len(*inputline\s)) ")
  WriteStringN(scanner\fileoutputchannel, "  If counter > 1 ")
  WriteStringN(scanner\fileoutputchannel, "    *tok\tokentype = #float")
  WriteStringN(scanner\fileoutputchannel, "    ProcedureReturn counter")
  WriteStringN(scanner\fileoutputchannel, "  Else ")
  WriteStringN(scanner\fileoutputchannel, "    *tok\tokentype = #none ")
  WriteStringN(scanner\fileoutputchannel, "    ProcedureReturn -97")
  WriteStringN(scanner\fileoutputchannel, "  EndIf")
  WriteStringN(scanner\fileoutputchannel, "EndProcedure ")
  WriteStringN(scanner\fileoutputchannel, " ")
  WriteStringN(scanner\fileoutputchannel, "Procedure.i GETSTRING(*inputline.string, *tok.token) ")
  WriteStringN(scanner\fileoutputchannel, "  If *inputline\s = "+Chr(34)+Chr(34))
  WriteStringN(scanner\fileoutputchannel, "    ProcedureReturn -100 ")
  WriteStringN(scanner\fileoutputchannel, "  EndIf")
  WriteStringN(scanner\fileoutputchannel, "  If Mid(*inputline\s, 1, 1) = Chr(34) ")
  WriteStringN(scanner\fileoutputchannel, "    Protected counter.l = 2")
  WriteStringN(scanner\fileoutputchannel, "    While Mid(*inputline\s, counter, 1) <> #CRLF$")
  WriteStringN(scanner\fileoutputchannel, "      If Mid(*inputline\s, counter, 1) = Chr(34) ")
  WriteStringN(scanner\fileoutputchannel, "        *tok\token = Mid(*inputline\s, 1, counter) ")
  WriteStringN(scanner\fileoutputchannel, "        counter + 1")
  WriteStringN(scanner\fileoutputchannel, "        *inputline\s = Mid(*inputline\s, counter, Len(*inputline\s)) ")
  WriteStringN(scanner\fileoutputchannel, "        *tok\tokentype = #string ")
  WriteStringN(scanner\fileoutputchannel, "        ProcedureReturn counter")
  WriteStringN(scanner\fileoutputchannel, "      Else ")
  WriteStringN(scanner\fileoutputchannel, "        counter + 1")
  WriteStringN(scanner\fileoutputchannel, "      EndIf")
  WriteStringN(scanner\fileoutputchannel, "    Wend ")
  WriteStringN(scanner\fileoutputchannel, "  EndIf")
  WriteStringN(scanner\fileoutputchannel, "  *tok\tokentype = #none ")
  WriteStringN(scanner\fileoutputchannel, "  ProcedureReturn -96")
  WriteStringN(scanner\fileoutputchannel, "EndProcedure ")
  WriteStringN(scanner\fileoutputchannel, " ")
  WriteStringN(scanner\fileoutputchannel, "Procedure.i GETANYCHAR(*inputline.string, *tok.token)")
  WriteStringN(scanner\fileoutputchannel, "  If *inputline\s = "+Chr(34)+Chr(34))
  WriteStringN(scanner\fileoutputchannel, "    ProcedureReturn -100 ")
  WriteStringN(scanner\fileoutputchannel, "  EndIf")
  WriteStringN(scanner\fileoutputchannel, "  *tok\token = Mid(*inputline\s, 1, 1) ")
  WriteStringN(scanner\fileoutputchannel, "  *inputline\s = Mid(*inputline\s, 2, 1) ")
  WriteStringN(scanner\fileoutputchannel, "  *tok\tokentype = #anychar")
  WriteStringN(scanner\fileoutputchannel, "  ProcedureReturn 1")
  WriteStringN(scanner\fileoutputchannel, "EndProcedure ")
  WriteStringN(scanner\fileoutputchannel, " ")
  WriteStringN(scanner\fileoutputchannel, "Procedure.i TESTTOKEN(*inputline.string, *tok.token, stoken.s) ")
  WriteStringN(scanner\fileoutputchannel, "  If *inputline\s = "+Chr(34)+Chr(34))
  WriteStringN(scanner\fileoutputchannel, "    ProcedureReturn -100 ")
  WriteStringN(scanner\fileoutputchannel, "  EndIf")
  WriteStringN(scanner\fileoutputchannel, "  Protected counter.i = Len(stoken)")
  WriteStringN(scanner\fileoutputchannel, "  If Mid(*inputline\s, 1, counter) = stoken")
  WriteStringN(scanner\fileoutputchannel, "    *tok\token = Mid(*inputline\s, 1, counter) ")
  WriteStringN(scanner\fileoutputchannel, "    *inputline\s = Mid(*inputline\s, counter+1, Len(*inputline\s)) ")
  WriteStringN(scanner\fileoutputchannel, "    ProcedureReturn counter")
  WriteStringN(scanner\fileoutputchannel, "  EndIf")
  WriteStringN(scanner\fileoutputchannel, "  ProcedureReturn -95")
  WriteStringN(scanner\fileoutputchannel, "EndProcedure ")
  WriteStringN(scanner\fileoutputchannel, " ")
  WriteStringN(scanner\fileoutputchannel, "Procedure.i SYNCTO(*inputline.string, SyncChar.s)")
  WriteStringN(scanner\fileoutputchannel, "  Protected counter.i = Len(SyncChar)")
  WriteStringN(scanner\fileoutputchannel, "  Repeat ")
  WriteStringN(scanner\fileoutputchannel, "    If Mid(*inputline\s, 1, counter) <> SyncChar ")
  WriteStringN(scanner\fileoutputchannel, "      *inputline\s = Mid(*inputline\s, counter+1,Len(*inputline\s))")
  WriteStringN(scanner\fileoutputchannel, "        ProcedureReturn -100 ")
  WriteStringN(scanner\fileoutputchannel, "    Else ")
  WriteStringN(scanner\fileoutputchannel, "      ProcedureReturn 1")
  WriteStringN(scanner\fileoutputchannel, "    EndIf")
  WriteStringN(scanner\fileoutputchannel, "  ForEver")
  WriteStringN(scanner\fileoutputchannel, "EndProcedure ")
  WriteStringN(scanner\fileoutputchannel, " ")
  WriteStringN(scanner\fileoutputchannel, "Procedure.i COLLECTTO(*inputline.string, *tok.token, CollectChars.s) ")
  WriteStringN(scanner\fileoutputchannel, "  *tok\token = "+Chr(34)+Chr(34))
  WriteStringN(scanner\fileoutputchannel, "  Repeat ")
  WriteStringN(scanner\fileoutputchannel, "    If *inputline\s = "+Chr(34)+Chr(34))
  WriteStringN(scanner\fileoutputchannel, "        ProcedureReturn -100 ")
  WriteStringN(scanner\fileoutputchannel, "    EndIf")
  WriteStringN(scanner\fileoutputchannel, "    Protected counter.i = FindString(*inputline\s, CollectChars, #PB_String_CaseSensitive) ")
  WriteStringN(scanner\fileoutputchannel, "    If counter > 0 ")
  WriteStringN(scanner\fileoutputchannel, "      *inputline\s = Mid(*inputline\s, counter + Len(CollectChars), Len(*inputline\s)) ")
  WriteStringN(scanner\fileoutputchannel, "      *tok\token = *tok\token + Mid(*inputline\s, 1, counter)")
  WriteStringN(scanner\fileoutputchannel, "      Break")
  WriteStringN(scanner\fileoutputchannel, "    EndIf")
  WriteStringN(scanner\fileoutputchannel, "    *tok\token = *tok\token + *inputline\s ")
  WriteStringN(scanner\fileoutputchannel, "    *inputline\s = "+Chr(34)+Chr(34))
  WriteStringN(scanner\fileoutputchannel, "  ForEver")
  WriteStringN(scanner\fileoutputchannel, "  *tok\tokentype = #collect")
  WriteStringN(scanner\fileoutputchannel, "  ProcedureReturn Len(*tok\token)")
  WriteStringN(scanner\fileoutputchannel, "EndProcedure ")
  WriteStringN(scanner\fileoutputchannel, " ")
  WriteStringN(scanner\fileoutputchannel, "Procedure.i GETNOT(*inputline.string, *tok.token, NotChar.s) ")
  WriteStringN(scanner\fileoutputchannel, "  If COLLECTTO(*inputline, *tok, NotChar) > 0")
  WriteStringN(scanner\fileoutputchannel, "    ProcedureReturn #True")
  WriteStringN(scanner\fileoutputchannel, "  Else ")
  WriteStringN(scanner\fileoutputchannel, "    ProcedureReturn #False ")
  WriteStringN(scanner\fileoutputchannel, "  EndIf")
  WriteStringN(scanner\fileoutputchannel, "EndProcedure ")
EndProcedure
Top
startup
Enthusiast
Enthusiast
Posts: 105
Joined: Wed Feb 25, 2015 5:55 pm

Re: meta pi compiler compiler

Post by startup »

Part 3 the scanner:

Code: Select all

DeclareModule meta_scanner
  EnableExplicit
  
  #atEOF          = -10000
  #MAXFILELIBRARIES = 10
  #MAXSTACKS      = 10
  #MAXINSTACK     = 1000
  #GETANIDERROR   = 1
  #TESTTOKENERROR = 2
  #GETINTERROR    = 3
  #GETREALERROR   = 4
  #GETSTRINGERROR = 5
  #GETANYCHARERROR= 6
  #SYNCTOERROR    = 7
  #COLLECTTOERROR = 8
  #CODEERROR      = 11
  #DOESSAVE       = 100
  #DOESOUT        = 101
  #DOESPREVIOUS   = 103
  #DOESNEW        = 104
  #FROMSAVE       = 1
  #FROMTOKEN      = 2
  #FROMOUT        = 3
  #FROMSTRING     = 4
  
  NewMap prototypes.s()
  Global protoypeFile.s = ""

  Enumeration toktype
    #none
    #string
    #integer
    #float
    #id
    #anychar
    #code
    #collect
  EndEnumeration
  
  Structure token
    token.s
    tokentype.i
  EndStructure
  
  Structure scan
   columncount.i
   largestColumn.i
   linecount.i
   fileinputchannel.i
   fileoutputchannel.i
   labelnumber.i
   libInProgress.i
   currentFile.i
   mainInputFile.i
   fileposition.q
   doingCode.i
   doingTrace.i
   doingToScreen.i
   mainIsSet.i
   token.token
   SaveString.s
   LabelName.s
   OutString.s
   inFilename.s
   mainName.s
   DEBUGS.i
   line_s.s
   org_line.s
   Array filelibraries.s(#MAXFILELIBRARIES)
   Array stack.token(#MAXSTACKS,#MAXINSTACK)
   Array stackpointer.i(#MAXSTACKS)
  EndStructure
  
  Global scanner.scan, tmpscanner.scan
  
  Declare   ClearScannerStructure(*p.scan)
  Declare   CopyScannerStructure(*out.scan, *in.scan)
  Declare.i IsWhite(char.s)
  Declare.i IsDigit(char.s)
  Declare.i GETANID()
  Declare.i GETINT()
  Declare.i GETREAL()
  Declare.i GETSTRING()
  Declare.i GETANYCHAR()
  Declare.i DOCODES(untils.s)
  Declare.i TESTTOKEN(stoken.s)
  Declare.i COLLECTTO(CollectChars.s)
  Declare.i GETNOT(NotChar.s)
  Declare.i SYNCTO(SyncChar.s)
  Declare   SAVETEMP(SaveStrings.s = "")
  Declare   DOLABEL(lmode.i, generate.i)
  Declare.i STACKS(fromwhat.i, stringvals.s = "", type.i=#none, whichs.i = 0)
  Declare   POPSTACK(whichs.i = 0)
  Declare   PEEKSTACK(element.i, whichs.i=0)
  Declare   PEEPSTACK(whichs.i=0)
  Declare   EMIT(EmitString.s, whichs.i=0)
  Declare   FLUSH()

EndDeclareModule

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Module meta_scanner
  EnableExplicit
  
  Procedure ClearScannerStructure(*p.scan)
    *p\columncount   = 0
    *p\largestColumn = 0
    *p\linecount     = 0
    *p\fileinputchannel  = 0
    *p\fileoutputchannel = 0
    *p\labelnumber   = 0
    *p\libInProgress = 0
    *p\currentFile   = 0
    *p\mainInputFile = 0
    *p\fileposition  = 0
    *p\doingCode     = #False
    *p\doingTrace    = #False
    *p\doingToScreen = #False
    *p\mainIsSet     = #False
    *p\token\token   = ""
    *p\token\tokentype= #none
    *p\SaveString    = ""
    *p\LabelName     = ""
    *p\OutString     = ""
    *p\inFilename    = ""
    *p\mainName      = ""
    *p\DEBUGS        = #False
    *p\line_s        = ""
    FreeArray(*p\filelibraries())
    Dim *p\filelibraries(#MAXFILELIBRARIES)
    FreeArray(*p\stack())
    Dim *p\stack(#MAXSTACKS, #MAXINSTACK)
    FreeArray(*p\stackpointer())
    *p\stackpointer(#MAXSTACKS)
  EndProcedure
  
  Procedure CopyScannerStructure(*out.scan, *in.scan)
    *out\columncount   =      *in\columncount
    *out\largestColumn =      *in\largestColumn
    *out\linecount     =      *in\linecount
    *out\fileinputchannel  =  *in\fileinputchannel
    *out\fileoutputchannel =  *in\fileoutputchannel
    *out\labelnumber   =      *in\labelnumber
    *out\libInProgress =      *in\libInProgress
    *out\currentFile   =      *in\currentFile
    *out\mainInputFile =      *in\mainInputFile
    *out\fileposition  =      *in\fileposition
    *out\doingCode     =      *in\doingCode
    *out\doingTrace    =      *in\doingTrace
    *out\doingToScreen =      *in\doingToScreen
    *out\mainIsSet     =      *in\mainIsSet
    *out\token\token   =      *in\token\token
    *out\token\tokentype=     *in\token\tokentype
    *out\SaveString    =      *in\SaveString
    *out\LabelName     =      *in\LabelName
    *out\OutString     =      *in\OutString
    *out\inFilename    =      *in\inFilename
    *out\mainName      =      *in\mainName
    *out\DEBUGS        =      *in\DEBUGS
    *out\line_s        =      *in\line_s
    CopyArray(*in\filelibraries(), *out\filelibraries())
    CopyArray(*in\stack(), *out\stack())
    CopyArray(*in\stackpointer(), *out\stackpointer())
  EndProcedure
  
  Procedure.i IsWhite(char.s)
    Select Asc(char)
      Case 32, 0
        ProcedureReturn #True     
      Default
        ProcedureReturn #False
    EndSelect
  EndProcedure
   
  Procedure.i IsDigit(char.s)
    Select Asc(char)
      Case 48 To 57, 46
        ProcedureReturn #True     
      Default
        ProcedureReturn #False
    EndSelect
  EndProcedure
  
  Procedure.i READLINE()
    scanner\line_s = Trim(ReadString(scanner\currentFile))
    scanner\fileposition = Loc(scanner\currentFile)
    scanner\linecount + 1
    scanner\columncount = 1
    scanner\org_line = scanner\line_s
    If scanner\line_s <> "" 
      scanner\columncount = Len(scanner\line_s)
      ProcedureReturn scanner\largestColumn
    Else
      If Eof(scanner\currentFile) 
        scanner\columncount = Len(scanner\line_s)
        ProcedureReturn #atEOF
      EndIf
      scanner\columncount = Len(scanner\line_s)
      ProcedureReturn -1
    EndIf
    scanner\columncount = Len(scanner\line_s)
    ProcedureReturn -1
  EndProcedure
  
  Procedure.i READCARD()
    READCARD1:
    If READLINE() = #atEOF 
      If scanner\libInProgress > 0 
        PrintN("++++++++++ END PARSING LIB " + scanner\filelibraries(scanner\libInProgress))
        CloseFile(scanner\libInProgress)
        scanner\libInProgress - 1
        If scanner\libInProgress = 0 
          scanner\currentFile = scanner\mainInputFile
          scanner\libInProgress = 0
        EndIf
        Goto READCARD1
      Else
        ProcedureReturn #atEOF
      EndIf
    EndIf
    If scanner\doingCode = #False 
      If Left(scanner\line_s, 1) = "#" 
        If Left(scanner\line_s, 4) = "#END" 
          If scanner\libInProgress > 0 
            PrintN("++++++++++ END PARSING LIB " + scanner\filelibraries(scanner\libInProgress))
            CloseFile(scanner\libInProgress)
            scanner\libInProgress - 1
            If scanner\libInProgress = 0 
              scanner\currentFile = scanner\mainInputFile
              scanner\libInProgress = 0
            EndIf
            Goto READCARD1
          Else
            ProcedureReturn #atEOF
          EndIf
          Goto READCARD1
        EndIf
        If Left(scanner\line_s, 5) = "#FILE" 
          If scanner\doingToScreen = #True 
            PrintN("LINE: " +Str(scanner\linecount))
            PrintN(scanner\line_s)
          EndIf
          scanner\line_s = Mid(scanner\line_s, 6,Len(scanner\line_s)) 
          If GETANID() > 0 
            CloseFile(scanner\currentFile)
            scanner\currentFile =  #PB_Any
            OpenFile(scanner\currentFile, scanner\token\token, #PB_File_SharedRead)
            FlushFileBuffers(scanner\fileoutputchannel)
          Else
            PrintN("ERROR in FILE command. Line: " + Str(scanner\linecount))
          EndIf
          Goto READCARD1
        EndIf
        If Left(scanner\line_s, 6) = "#LABEL" 
          If scanner\doingToScreen = #True 
            PrintN("LINE: " +Str(scanner\linecount))
            PrintN(scanner\line_s)
          EndIf
          scanner\line_s = Mid(scanner\line_s, 7,Len(scanner\line_s)) 
          If GETANID() > 0 
            scanner\LabelName = scanner\token\token
            scanner\labelnumber = 0
          EndIf
          Goto READCARD1
        EndIf
        If Left(scanner\line_s, 4) = "#LIB" 
          If scanner\doingToScreen = #True 
            PrintN("LINE: " +Str(scanner\linecount))
            PrintN(scanner\line_s)
          EndIf
          scanner\line_s = Mid(scanner\line_s, 5,Len(scanner\line_s))
          If GETANID() > 0 
            scanner\libInProgress + 1
            scanner\filelibraries(scanner\libInProgress) = scanner\token\token
            OpenFile(scanner\libInProgress, scanner\filelibraries(scanner\libInProgress), #PB_File_SharedRead)
            FlushFileBuffers(scanner\fileoutputchannel)
            scanner\currentFile = scanner\libInProgress
          Else
            PrintN("ERROR in LIB command. Line: " + scanner\linecount)
          EndIf
          Goto READCARD1
        EndIf
        If Left(scanner\line_s, 5) = "#MAIN" 
          scanner\line_s = Trim(Mid(scanner\line_s, 6,Len(scanner\line_s)))
          If Len(scanner\line_s) > 0 ;GETANID() > 0 
            scanner\mainIsSet = #True
            scanner\mainName = scanner\line_s ;scanner\token\token
            scanner\line_s = ""
          EndIf
          If scanner\doingToScreen = #True 
            PrintN("LINE: " +Str(scanner\linecount))
            PrintN(scanner\line_s)
          EndIf
          Goto READCARD1
        EndIf
        If Left(scanner\line_s, 7) = "#SCREEN" 
          If scanner\doingToScreen = #True 
            scanner\doingToScreen = #False
          Else
            scanner\doingToScreen = #True
          EndIf
          Goto READCARD1
        EndIf
        If Left(scanner\line_s, 7) = "#DEBUGS"
          If scanner\DEBUGS = #True 
            scanner\DEBUGS = #False
          Else
            scanner\DEBUGS = #True
          EndIf
          Goto READCARD1
        EndIf
        If Left(scanner\line_s, 6) = "#TRACE" 
          If scanner\doingTrace = #True 
            scanner\doingTrace = #False
          Else
            scanner\doingTrace = #True
          EndIf
          Goto READCARD1
        EndIf
        If Left(scanner\line_s, 2) = "//" 
          Goto READCARD1
        Else
          PrintN("Incorrect ;#; command in file " + scanner\inFilename)
          PrintN(scanner\line_s)
        EndIf
      EndIf
    EndIf
    If Left(scanner\line_s, 2) = "@@" 
      If scanner\doingCode = #False 
         WriteStringN(scanner\fileoutputchannel, "")
         WriteStringN(scanner\fileoutputchannel, "; START OF USER CODE")
         WriteStringN(scanner\fileoutputchannel, "")
         scanner\doingCode = #True
      Else
         WriteStringN(scanner\fileoutputchannel, "")
         WriteStringN(scanner\fileoutputchannel, "; END   OF USER CODE")
         WriteStringN(scanner\fileoutputchannel, "")
         scanner\doingCode = #False
      EndIf
      Goto READCARD1
    EndIf
    If scanner\doingTrace = #True
       WriteStringN(scanner\fileoutputchannel, ";")
       WriteStringN(scanner\fileoutputchannel, "; "+ scanner\line_s)
       WriteStringN(scanner\fileoutputchannel, ";")
    EndIf
    If scanner\doingToScreen = #True 
      PrintN("LINE: " +Str(scanner\linecount))
      PrintN(scanner\line_s)
      ;PrintN("")
    EndIf
    If scanner\doingCode = #True 
       WriteStringN(scanner\fileoutputchannel, scanner\line_s)
      Goto READCARD1
    EndIf
    If Left(scanner\line_s, 2) = "//" 
      Goto READCARD1
    EndIf
    ProcedureReturn 1
  EndProcedure
  
  Procedure.i SPAN()
    scanner\line_s = Trim(scanner\line_s)
    While scanner\line_s = ""
      If READCARD() = #atEOF
        ProcedureReturn #atEOF
      EndIf
      scanner\line_s = Trim(scanner\line_s)
    Wend
    If scanner\columncount > 1 
      scanner\columncount = Len(scanner\line_s) - scanner\largestColumn
    EndIf
    ProcedureReturn 0
  EndProcedure
  
  Procedure.i GETANID()
    If SPAN() = #atEOF 
      ProcedureReturn (#atEOF|#GETANIDERROR)
    EndIf
    Select Asc(Mid(scanner\line_s, 1, 1))
      Case 65 To 90, 97 To 122, 95
      Default
        ProcedureReturn - #GETANIDERROR
    EndSelect
    scanner\token\token = ""
    Protected counter.i = 1
    While Mid(scanner\line_s, counter, 1) <> #CRLF$
      Select Asc(Mid(scanner\line_s, counter, 1))
        Case 65 To 90, 97 To 122, 48 To 57, 95
          scanner\token\token = scanner\token\token + Mid(scanner\line_s, counter, 1)
          counter + 1
        Default        
          scanner\line_s = Mid(scanner\line_s, counter, Len(scanner\line_s))
          scanner\columncount = Len(scanner\line_s)
          scanner\token\tokentype = #id
          ProcedureReturn counter - 1
          Break
      EndSelect
    Wend
    scanner\token\tokentype = #none
  EndProcedure
  
  Procedure.i GETINT()
    If SPAN() = #atEOF 
      ProcedureReturn (#atEOF|#GETINTERROR)
    EndIf
    Select Asc(Mid(scanner\line_s, 1, 1))
      Case 48 To 57
      Default
        ProcedureReturn -(#GETINTERROR)
    EndSelect
    scanner\token\token = ""
    Protected counter.l = 1
    While Mid(scanner\line_s, counter, 1) <> #CRLF$
      Select Asc(Mid(scanner\line_s, counter, 1))
        Case 48 To 57
          scanner\token\token = scanner\token\token + Mid(scanner\line_s, counter, 1)
          counter + 1 
        Default
          scanner\line_s = Mid(scanner\line_s, counter, Len(scanner\line_s))
          scanner\columncount = Len(scanner\line_s)
          scanner\token\tokentype = #integer
          ProcedureReturn counter-1
      EndSelect
    Wend
    scanner\token\tokentype = #none
  EndProcedure
  
  Procedure.i GETREAL()
    Protected counter.l = 1
    Protected matchPosition.l
    If SPAN() = #atEOF 
      ProcedureReturn -(#atEOF | #GETREALERROR)
    EndIf
    Select Asc(Mid(scanner\line_s, 1, 1))
      Case Asc("0") To Asc("9")
        counter = 1
      Case Asc(".")
        If IsDigit(Mid(scanner\line_s, 1, 1)) 
          counter = 2
        Else
          ProcedureReturn -(#atEOF | #GETREALERROR)
        EndIf          
      Default
        ProcedureReturn -(#atEOF | #GETREALERROR)
    EndSelect
    While Mid(scanner\line_s, counter, 1) <> #CRLF$
      Select  Asc(Mid(scanner\line_s, counter, 1))
        Case Asc("0") To Asc("9")
          scanner\token\token = scanner\token\token + Mid(scanner\line_s, counter, 1)
          counter + 1 
        Default
          counter - 1
          Break
      EndSelect
    Wend
    If Mid(scanner\line_s, counter, 1) <> #CRLF$ 
      If Mid(scanner\line_s, counter+1, 1) = "E" Or Mid(scanner\line_s, counter, 1) = "e" 
        If Mid(scanner\line_s, counter+2, 1) = "+" Or Mid(scanner\line_s, counter, 1) = "-" 
          counter + 2
          scanner\token\token = scanner\token\token + Mid(scanner\line_s, counter, 1)
        Else
          counter + 1
        EndIf
        While Mid(scanner\line_s, counter, 1) <> #CRLF$
          Select  Asc(Mid(scanner\line_s, counter, 1))
            Case Asc("0") To Asc("9")
              scanner\token\token = scanner\token\token + Mid(scanner\line_s, counter, 1)
              counter + 1 
            Default
              counter - 1
              Break
          EndSelect
        Wend
      EndIf
    EndIf
    scanner\token\token = Mid(scanner\line_s, 1, counter)
    scanner\line_s = Mid(scanner\line_s, counter+1, Len(scanner\line_s))
    If counter > 1 
      scanner\columncount = Len(scanner\line_s)
      scanner\token\tokentype = #float
      ProcedureReturn counter
    Else
      scanner\token\tokentype = #none
      ProcedureReturn -(#GETREALERROR)
    EndIf
  EndProcedure
  
  Procedure.i GETSTRING()
    If SPAN() = #atEOF 
      ProcedureReturn (#atEOF|#GETSTRINGERROR)
    EndIf
    If Mid(scanner\line_s, 1, 1) = Chr(34) 
      Protected counter.l = 2
      While Mid(scanner\line_s, counter, 1) <> #CRLF$
        If Mid(scanner\line_s, counter, 1) = Chr(34)
          scanner\token\token = Mid(scanner\line_s, 1, counter)
          counter + 1
          scanner\line_s = Mid(scanner\line_s, counter, Len(scanner\line_s))
          scanner\token\tokentype = #string
          ProcedureReturn counter
        Else
          counter + 1
        EndIf
      Wend
    EndIf
    scanner\token\tokentype = #none
    ProcedureReturn -(#GETSTRINGERROR)
  EndProcedure
  
  Procedure.i GETANYCHAR()
    If scanner\line_s = "" 
      If SPAN() = #atEOF 
        ProcedureReturn (#atEOF|#GETANYCHARERROR)
      EndIf
    EndIf
    scanner\token\token = Mid(scanner\line_s, 1, 1)
    scanner\line_s = Mid(scanner\line_s, 2, 1)
    scanner\token\tokentype = #anychar
    ProcedureReturn 1
  EndProcedure
  
  Procedure.i DOCODES(untils.s)
    Protected counter.l
    Repeat
      If scanner\line_s = "" 
        If SPAN() = #atEOF
          scanner\columncount = Len(scanner\line_s)
          ProcedureReturn (#atEOF|#CODEERROR)
        EndIf
      EndIf
      counter = FindString(scanner\line_s, untils,1)
      If counter > 0 
        WriteStringN(scanner\fileoutputchannel, Mid(scanner\line_s, 1, counter-1))
        scanner\line_s = Mid(scanner\line_s, counter + Len(untils), Len(scanner\line_s)) 
        scanner\columncount = Len(scanner\line_s)
        scanner\token\tokentype = #code
        ProcedureReturn 1
      EndIf
      WriteStringN(scanner\fileoutputchannel, scanner\line_s)
      scanner\line_s = ""
    ForEver
    ProcedureReturn -(#CODEERROR)
  EndProcedure
  
  Procedure.i TESTTOKEN(stoken.s)
    If SPAN() = #atEOF 
      ProcedureReturn (#atEOF | #TESTTOKENERROR)
    EndIf
    Protected counter.i = Len(stoken)
    If Mid(scanner\line_s, 1, counter) = stoken 
      scanner\token\token = Mid(scanner\line_s, 1, counter)
      scanner\line_s = Mid(scanner\line_s, counter+1, Len(scanner\line_s)) 
      scanner\columncount = Len(scanner\line_s)
      ProcedureReturn counter
    EndIf
    ProcedureReturn -(#TESTTOKENERROR)
  EndProcedure
  
  Procedure.i COLLECTTO(CollectChars.s)
    scanner\token\token = ""
    Repeat
      If scanner\line_s = "" 
        If SPAN() = #atEOF 
          ProcedureReturn (#atEOF|#COLLECTTOERROR)
        EndIf
      EndIf
      Protected counter.i = FindString(scanner\line_s, CollectChars, #PB_String_CaseSensitive)
      If counter > 0 
        scanner\line_s = Mid(scanner\line_s, counter + Len(CollectChars), Len(scanner\line_s))
        scanner\token\token = scanner\token\token + Mid(scanner\line_s, 1, counter)
        Break
      EndIf
      scanner\token\token = scanner\token\token + scanner\line_s
      scanner\line_s = ""
    ForEver
    scanner\columncount = Len(scanner\line_s)
    scanner\token\tokentype = #collect
    ProcedureReturn Len(scanner\token\token)
  EndProcedure
  
  Procedure.i GETNOT(NotChar.s)
    If COLLECTTO(NotChar) > 0 
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  EndProcedure
  
  Procedure.i SYNCTO(SyncChar.s)
    Protected counter.i = Len(SyncChar)
    Repeat
      If Mid(scanner\line_s, 1, counter) <> SyncChar 
        scanner\line_s = Mid(scanner\line_s, counter+1,Len(scanner\line_s))
        If SPAN() = #atEOF 
          ProcedureReturn (#atEOF | #SYNCTOERROR)
        EndIf
      Else
        scanner\columncount = Len(scanner\line_s)
        ProcedureReturn 1
      EndIf
    ForEver
  EndProcedure
  
  Procedure SAVETEMP(SaveStrings.s = "")
    If SaveStrings = "" 
      scanner\SaveString = scanner\SaveString + scanner\token\token
      scanner\token\token = ""
    Else
      scanner\SaveString = scanner\SaveString + SaveStrings
    EndIf
  EndProcedure
  
  Procedure DOLABEL(lmode.i, generate.i)
    Select lmode
      Case #DOESNEW
        scanner\labelnumber + 1
        scanner\token\token = scanner\LabelName + Trim(Str(scanner\labelnumber))
        Select  generate
          Case #DOESOUT
            scanner\OutString = scanner\OutString + scanner\token\token
          Case #DOESSAVE
            scanner\SaveString = scanner\SaveString + scanner\token\token
        EndSelect
      Case #DOESPREVIOUS
        Select  generate
          Case #DOESOUT
            scanner\OutString = scanner\OutString + scanner\token\token
          Case #DOESSAVE
            scanner\SaveString = scanner\SaveString + scanner\token\token
        EndSelect
    EndSelect
  EndProcedure
  
  Procedure.i STACKS(fromwhat.i, stringvals.s = "", type.i=#none, whichs.i = 0)
    Protected which.i
;     Protected stringval.s
;     stringval = stringvals
    which = whichs
    scanner\stackpointer(which) + 1
    If scanner\stackpointer(which) < #MAXINSTACK 
      If fromwhat = #FROMSAVE 
        scanner\stack(which, scanner\stackpointer(which))\token = scanner\SaveString
        scanner\stack(which, scanner\stackpointer(which))\tokentype = type
        scanner\SaveString = ""
      Else
        If fromwhat = #FROMTOKEN 
          scanner\stack(which, scanner\stackpointer(which))\token = scanner\token\token
          If type = #none And scanner\token\tokentype <> #none
            scanner\stack(which, scanner\stackpointer(which))\tokentype = scanner\token\tokentype
          Else
            scanner\stack(which, scanner\stackpointer(which))\tokentype = type
          EndIf
          scanner\token\token = ""
        Else
          scanner\stack(which, scanner\stackpointer(which))\token = stringvals
          scanner\stack(which, scanner\stackpointer(which))\tokentype = type
        EndIf
      EndIf
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  EndProcedure
  
  Procedure POPSTACK(whichs.i = 0)
    Protected which.i
    which = whichs
    If scanner\stackpointer(which) > 0 
      scanner\token\token = scanner\stack(which, scanner\stackpointer(which))\token
      scanner\token\tokentype = scanner\stack(which, scanner\stackpointer(which))\tokentype
      scanner\stack(which, scanner\stackpointer(which))\token = ""
      scanner\stack(which, scanner\stackpointer(which))\tokentype = #none
      scanner\stackpointer(which) - 1
    EndIf
  EndProcedure
  
  Procedure PEEKSTACK(element.i, whichs.i=0)
    Protected which.i
    which = whichs
    If element > 0 
      scanner\token\token = scanner\stack(which, element)\token
      scanner\token\tokentype = scanner\stack(which, element)\tokentype
    EndIf
  EndProcedure
  
  Procedure PEEPSTACK(whichs.i=0)
    Protected which.i
    which = whichs
    If scanner\stackpointer(which) > 0 
      scanner\token\token = scanner\stack(which, scanner\stackpointer(which))\token
      scanner\token\tokentype = scanner\stack(which, scanner\stackpointer(which))\tokentype
    EndIf
  EndProcedure
  
  Procedure EMIT(EmitString.s, whichs.i=0)
    Protected which.i
    which = whichs
    If which = #FROMOUT 
      scanner\OutString = scanner\OutString + scanner\token\token
    Else
      If which = #FROMSAVE 
        scanner\OutString = scanner\OutString + scanner\SaveString
      Else
        If which = #FROMSTRING 
          scanner\OutString = scanner\OutString + Chr(34) + scanner\token\token + Chr(34)
        Else
          scanner\OutString = scanner\OutString + EmitString
        EndIf
      EndIf
    EndIf
  EndProcedure
  
  Procedure FLUSH()
    WriteStringN(scanner\fileoutputchannel, scanner\OutString)
    scanner\OutString = ""
  EndProcedure

EndModule
Top
startup
Enthusiast
Enthusiast
Posts: 105
Joined: Wed Feb 25, 2015 5:55 pm

Re: meta pi compiler compiler

Post by startup »

well, nobody seems to interested - so this will be the last update. it works great for me.
the following part 1+2 of the compiler + a simple example.

copy 1st and 2nd of the following posts into one file. the 3rd is the scanner and the 4th is a little demo. does it work -well yes i use it for a larger expert system rule interpreter (67 rule - all annotated and attributed) and it works great.

in this version:

better code infusion, bug fixes and the END
Last edited by startup on Sat Oct 17, 2015 8:55 pm, edited 4 times in total.
Top
startup
Enthusiast
Enthusiast
Posts: 105
Joined: Wed Feb 25, 2015 5:55 pm

Re: meta pi compiler compiler

Post by startup »

part 1 of compiler. part 1 and 2 have be pasted together as one file

Code: Select all

XIncludeFile "modul_scanner.pbi"

EnableExplicit
UseModule meta_scanner

Procedure WriteScanner()
  WriteStringN(scanner\fileoutputchannel, "Enumeration toktype")
  WriteStringN(scanner\fileoutputchannel, "  #none")
  WriteStringN(scanner\fileoutputchannel, "  #string")
  WriteStringN(scanner\fileoutputchannel, "  #integer ")
  WriteStringN(scanner\fileoutputchannel, "  #float ")
  WriteStringN(scanner\fileoutputchannel, "  #id")
  WriteStringN(scanner\fileoutputchannel, "  #anychar ")
  WriteStringN(scanner\fileoutputchannel, "  #code")
  WriteStringN(scanner\fileoutputchannel, "  #collect ")
  WriteStringN(scanner\fileoutputchannel, "EndEnumeration ")
  WriteStringN(scanner\fileoutputchannel, " ")
  WriteStringN(scanner\fileoutputchannel, "Structure token")
  WriteStringN(scanner\fileoutputchannel, "  token.s")
  WriteStringN(scanner\fileoutputchannel, "  tokentype.i")
  WriteStringN(scanner\fileoutputchannel, "EndStructure ")
  WriteStringN(scanner\fileoutputchannel, " ")
  WriteStringN(scanner\fileoutputchannel, "Structure scan ")
  WriteStringN(scanner\fileoutputchannel, " token.token ")
  WriteStringN(scanner\fileoutputchannel, " line_s.s")
  WriteStringN(scanner\fileoutputchannel, " columncount.i ")
  WriteStringN(scanner\fileoutputchannel, "EndStructure ")
  WriteStringN(scanner\fileoutputchannel, " ")
  WriteStringN(scanner\fileoutputchannel, "Global scanner.scan")
  WriteStringN(scanner\fileoutputchannel, " ")
  WriteStringN(scanner\fileoutputchannel, "Procedure CopyScannerStructure(*out.scan, *in.scan)")
  WriteStringN(scanner\fileoutputchannel, "  *out\columncount   =      *in\columncount")
  WriteStringN(scanner\fileoutputchannel, "  *out\token\token   =      *in\token\token")
  WriteStringN(scanner\fileoutputchannel, "  *out\token\tokentype=     *in\token\tokentype")
  WriteStringN(scanner\fileoutputchannel, "  *out\line_s        =      *in\line_s")
  WriteStringN(scanner\fileoutputchannel, "EndProcedure")
  WriteStringN(scanner\fileoutputchannel, "")
  WriteStringN(scanner\fileoutputchannel, "Procedure.i IsDigit(char.s)")
  WriteStringN(scanner\fileoutputchannel, "  Select Asc(char) ")
  WriteStringN(scanner\fileoutputchannel, "    Case 48 To 57, 46")
  WriteStringN(scanner\fileoutputchannel, "      ProcedureReturn #True")
  WriteStringN(scanner\fileoutputchannel, "    Default")
  WriteStringN(scanner\fileoutputchannel, "      ProcedureReturn #False ")
  WriteStringN(scanner\fileoutputchannel, "  EndSelect")
  WriteStringN(scanner\fileoutputchannel, "EndProcedure ")
  WriteStringN(scanner\fileoutputchannel, " ")
  WriteStringN(scanner\fileoutputchannel, "Procedure.i GETANID()")
  WriteStringN(scanner\fileoutputchannel, "  scanner\line_s = Trim(scanner\line_s)")
  WriteStringN(scanner\fileoutputchannel, "  If scanner\line_s = "+Chr(34)+Chr(34)+"")
  WriteStringN(scanner\fileoutputchannel, "    ProcedureReturn -100 ")
  WriteStringN(scanner\fileoutputchannel, "  EndIf")
  WriteStringN(scanner\fileoutputchannel, "  Select Asc(Mid(scanner\line_s, 1, 1))")
  WriteStringN(scanner\fileoutputchannel, "    Case 65 To 90, 97 To 122, 95 ")
  WriteStringN(scanner\fileoutputchannel, "    Default")
  WriteStringN(scanner\fileoutputchannel, "      ProcedureReturn -50")
  WriteStringN(scanner\fileoutputchannel, "  EndSelect")
  WriteStringN(scanner\fileoutputchannel, "  scanner\token\token = "+Chr(34)+Chr(34)+"")
  WriteStringN(scanner\fileoutputchannel, "  Protected counter.i = 1")
  WriteStringN(scanner\fileoutputchannel, "  While Mid(scanner\line_s, counter, 1) <> #CRLF$")
  WriteStringN(scanner\fileoutputchannel, "    Select Asc(Mid(scanner\line_s, counter, 1))")
  WriteStringN(scanner\fileoutputchannel, "      Case 65 To 90, 97 To 122, 48 To 57, 95 ")
  WriteStringN(scanner\fileoutputchannel, "        scanner\token\token = scanner\token\token + Mid(scanner\line_s, counter, 1)")
  WriteStringN(scanner\fileoutputchannel, "        counter + 1")
  WriteStringN(scanner\fileoutputchannel, "      Default")
  WriteStringN(scanner\fileoutputchannel, "        scanner\line_s = Mid(scanner\line_s, counter, Len(scanner\line_s)) ")
  WriteStringN(scanner\fileoutputchannel, "        scanner\columncount = Len(scanner\line_s)")
  WriteStringN(scanner\fileoutputchannel, "        scanner\token\tokentype = #id")
  WriteStringN(scanner\fileoutputchannel, "        ProcedureReturn counter - 1")
  WriteStringN(scanner\fileoutputchannel, "        Break")
  WriteStringN(scanner\fileoutputchannel, "    EndSelect")
  WriteStringN(scanner\fileoutputchannel, "  Wend ")
  WriteStringN(scanner\fileoutputchannel, "  scanner\token\tokentype = #none")
  WriteStringN(scanner\fileoutputchannel, "EndProcedure ")
  WriteStringN(scanner\fileoutputchannel, " ")
  WriteStringN(scanner\fileoutputchannel, "Procedure.i GETINT() ")
  WriteStringN(scanner\fileoutputchannel, "  scanner\line_s = Trim(scanner\line_s)")
  WriteStringN(scanner\fileoutputchannel, "  If scanner\line_s = "+Chr(34)+Chr(34)+"")
  WriteStringN(scanner\fileoutputchannel, "    ProcedureReturn -100 ")
  WriteStringN(scanner\fileoutputchannel, "  EndIf")
  WriteStringN(scanner\fileoutputchannel, "  Select Asc(Mid(scanner\line_s, 1, 1))")
  WriteStringN(scanner\fileoutputchannel, "    Case 48 To 57")
  WriteStringN(scanner\fileoutputchannel, "    Default")
  WriteStringN(scanner\fileoutputchannel, "      ProcedureReturn -51")
  WriteStringN(scanner\fileoutputchannel, "  EndSelect")
  WriteStringN(scanner\fileoutputchannel, "  scanner\token\token = "+Chr(34)+Chr(34)+"")
  WriteStringN(scanner\fileoutputchannel, "  Protected counter.l = 1")
  WriteStringN(scanner\fileoutputchannel, "  While Mid(scanner\line_s, counter, 1) <> #CRLF$")
  WriteStringN(scanner\fileoutputchannel, "    Select Asc(Mid(scanner\line_s, counter, 1))")
  WriteStringN(scanner\fileoutputchannel, "      Case 48 To 57")
  WriteStringN(scanner\fileoutputchannel, "        scanner\token\token = scanner\token\token + Mid(scanner\line_s, counter, 1)")
  WriteStringN(scanner\fileoutputchannel, "        counter + 1")
  WriteStringN(scanner\fileoutputchannel, "      Default")
  WriteStringN(scanner\fileoutputchannel, "        scanner\line_s = Mid(scanner\line_s, counter, Len(scanner\line_s)) ")
  WriteStringN(scanner\fileoutputchannel, "        scanner\columncount = Len(scanner\line_s)")
  WriteStringN(scanner\fileoutputchannel, "        scanner\token\tokentype = #integer ")
  WriteStringN(scanner\fileoutputchannel, "        ProcedureReturn counter-1")
  WriteStringN(scanner\fileoutputchannel, "    EndSelect")
  WriteStringN(scanner\fileoutputchannel, "  Wend ")
  WriteStringN(scanner\fileoutputchannel, "  scanner\token\tokentype = #none")
  WriteStringN(scanner\fileoutputchannel, "EndProcedure ")
  WriteStringN(scanner\fileoutputchannel, " ")
  WriteStringN(scanner\fileoutputchannel, "Procedure.i GETREAL()")
  WriteStringN(scanner\fileoutputchannel, "  Protected counter.l = 1")
  WriteStringN(scanner\fileoutputchannel, "  Protected matchPosition.l")
  WriteStringN(scanner\fileoutputchannel, "  scanner\line_s = Trim(scanner\line_s)")
  WriteStringN(scanner\fileoutputchannel, "  If scanner\line_s = "+Chr(34)+Chr(34)+"")
  WriteStringN(scanner\fileoutputchannel, "    ProcedureReturn -100 ")
  WriteStringN(scanner\fileoutputchannel, "  EndIf")
  WriteStringN(scanner\fileoutputchannel, "  Select Asc(Mid(scanner\line_s, 1, 1))")
  WriteStringN(scanner\fileoutputchannel, "    Case Asc("+Chr(34)+"0"+Chr(34)+") To Asc("+Chr(34)+"9"+Chr(34)+")")
  WriteStringN(scanner\fileoutputchannel, "      counter = 1")
  WriteStringN(scanner\fileoutputchannel, "    Case Asc("+Chr(34)+"."+Chr(34)+")")
  WriteStringN(scanner\fileoutputchannel, "      If IsDigit(Mid(scanner\line_s, 1, 1))")
  WriteStringN(scanner\fileoutputchannel, "        counter = 2")
  WriteStringN(scanner\fileoutputchannel, "      Else ")
  WriteStringN(scanner\fileoutputchannel, "        ProcedureReturn -52")
  WriteStringN(scanner\fileoutputchannel, "      EndIf")
  WriteStringN(scanner\fileoutputchannel, "    Default")
  WriteStringN(scanner\fileoutputchannel, "      ProcedureReturn -52")
  WriteStringN(scanner\fileoutputchannel, "  EndSelect")
  WriteStringN(scanner\fileoutputchannel, "  While Mid(scanner\line_s, counter, 1) <> #CRLF$")
  WriteStringN(scanner\fileoutputchannel, "    Select  Asc(Mid(scanner\line_s, counter, 1)) ")
  WriteStringN(scanner\fileoutputchannel, "      Case Asc("+Chr(34)+"0"+Chr(34)+") To Asc("+Chr(34)+"9"+Chr(34)+")")
  WriteStringN(scanner\fileoutputchannel, "        scanner\token\token = scanner\token\token + Mid(scanner\line_s, counter, 1)")
  WriteStringN(scanner\fileoutputchannel, "        counter + 1")
  WriteStringN(scanner\fileoutputchannel, "      Default")
  WriteStringN(scanner\fileoutputchannel, "        counter - 1")
  WriteStringN(scanner\fileoutputchannel, "        Break")
  WriteStringN(scanner\fileoutputchannel, "    EndSelect")
  WriteStringN(scanner\fileoutputchannel, "  Wend ")
  WriteStringN(scanner\fileoutputchannel, "  If Mid(scanner\line_s, counter, 1) <> #CRLF$ ")
  WriteStringN(scanner\fileoutputchannel, "    If Mid(scanner\line_s, counter+1, 1) = "+Chr(34)+"E"+Chr(34)+" Or Mid(scanner\line_s, counter, 1) = "+Chr(34)+"e"+Chr(34)+"")
  WriteStringN(scanner\fileoutputchannel, "      If Mid(scanner\line_s, counter+2, 1) = "+Chr(34)+"+"+Chr(34)+" Or Mid(scanner\line_s, counter, 1) = "+Chr(34)+"+"+Chr(34)+"")
  WriteStringN(scanner\fileoutputchannel, "        counter + 2")
  WriteStringN(scanner\fileoutputchannel, "        scanner\token\token = scanner\token\token + Mid(scanner\line_s, counter, 1)")
  WriteStringN(scanner\fileoutputchannel, "      Else ")
  WriteStringN(scanner\fileoutputchannel, "        counter + 1")
  WriteStringN(scanner\fileoutputchannel, "      EndIf")
  WriteStringN(scanner\fileoutputchannel, "      While Mid(scanner\line_s, counter, 1) <> #CRLF$")
  WriteStringN(scanner\fileoutputchannel, "        Select  Asc(Mid(scanner\line_s, counter, 1)) ")
  WriteStringN(scanner\fileoutputchannel, "          Case Asc("+Chr(34)+"0"+Chr(34)+") To Asc("+Chr(34)+"9"+Chr(34)+")")
  WriteStringN(scanner\fileoutputchannel, "            scanner\token\token = scanner\token\token + Mid(scanner\line_s, counter, 1)")
  WriteStringN(scanner\fileoutputchannel, "            counter + 1")
  WriteStringN(scanner\fileoutputchannel, "          Default")
  WriteStringN(scanner\fileoutputchannel, "            counter - 1")
  WriteStringN(scanner\fileoutputchannel, "            Break")
  WriteStringN(scanner\fileoutputchannel, "        EndSelect")
  WriteStringN(scanner\fileoutputchannel, "      Wend ")
  WriteStringN(scanner\fileoutputchannel, "    EndIf")
  WriteStringN(scanner\fileoutputchannel, "  EndIf")
  WriteStringN(scanner\fileoutputchannel, "  scanner\token\token = Mid(scanner\line_s, 1, counter)")
  WriteStringN(scanner\fileoutputchannel, "  scanner\line_s = Mid(scanner\line_s, counter+1, Len(scanner\line_s)) ")
  WriteStringN(scanner\fileoutputchannel, "  If counter > 1 ")
  WriteStringN(scanner\fileoutputchannel, "    scanner\columncount = Len(scanner\line_s)")
  WriteStringN(scanner\fileoutputchannel, "    scanner\token\tokentype = #float ")
  WriteStringN(scanner\fileoutputchannel, "    ProcedureReturn counter")
  WriteStringN(scanner\fileoutputchannel, "  Else ")
  WriteStringN(scanner\fileoutputchannel, "    scanner\token\tokentype = #none")
  WriteStringN(scanner\fileoutputchannel, "    ProcedureReturn -53")
  WriteStringN(scanner\fileoutputchannel, "  EndIf")
  WriteStringN(scanner\fileoutputchannel, "EndProcedure ")
  WriteStringN(scanner\fileoutputchannel, " ")
  WriteStringN(scanner\fileoutputchannel, "Procedure.i GETSTRING()")
  WriteStringN(scanner\fileoutputchannel, "  scanner\line_s = Trim(scanner\line_s)")
  WriteStringN(scanner\fileoutputchannel, "  If scanner\line_s = "+Chr(34)+Chr(34)+"")
  WriteStringN(scanner\fileoutputchannel, "    ProcedureReturn -100 ")
  WriteStringN(scanner\fileoutputchannel, "  EndIf")
  WriteStringN(scanner\fileoutputchannel, "  If Mid(scanner\line_s, 1, 1) = Chr(34) ")
  WriteStringN(scanner\fileoutputchannel, "    Protected counter.l = 2")
  WriteStringN(scanner\fileoutputchannel, "    While Mid(scanner\line_s, counter, 1) <> #CRLF$")
  WriteStringN(scanner\fileoutputchannel, "      If Mid(scanner\line_s, counter, 1) = Chr(34) ")
  WriteStringN(scanner\fileoutputchannel, "        scanner\token\token = Mid(scanner\line_s, 1, counter)")
  WriteStringN(scanner\fileoutputchannel, "        counter + 1")
  WriteStringN(scanner\fileoutputchannel, "        scanner\line_s = Mid(scanner\line_s, counter, Len(scanner\line_s)) ")
  WriteStringN(scanner\fileoutputchannel, "        scanner\token\tokentype = #string")
  WriteStringN(scanner\fileoutputchannel, "        ProcedureReturn counter")
  WriteStringN(scanner\fileoutputchannel, "      Else ")
  WriteStringN(scanner\fileoutputchannel, "        counter + 1")
  WriteStringN(scanner\fileoutputchannel, "      EndIf")
  WriteStringN(scanner\fileoutputchannel, "    Wend ")
  WriteStringN(scanner\fileoutputchannel, "  EndIf")
  WriteStringN(scanner\fileoutputchannel, "  scanner\token\tokentype = #none")
  WriteStringN(scanner\fileoutputchannel, "  ProcedureReturn -54")
  WriteStringN(scanner\fileoutputchannel, "EndProcedure ")
  WriteStringN(scanner\fileoutputchannel, " ")
  WriteStringN(scanner\fileoutputchannel, "Procedure.i GETANYCHAR() ")
  WriteStringN(scanner\fileoutputchannel, "  scanner\line_s = Trim(scanner\line_s)")
  WriteStringN(scanner\fileoutputchannel, "  If scanner\line_s = "+Chr(34)+Chr(34)+"")
  WriteStringN(scanner\fileoutputchannel, "    ProcedureReturn -100 ")
  WriteStringN(scanner\fileoutputchannel, "  EndIf")
  WriteStringN(scanner\fileoutputchannel, "  scanner\token\token = Mid(scanner\line_s, 1, 1)")
  WriteStringN(scanner\fileoutputchannel, "  scanner\line_s = Mid(scanner\line_s, 2, 1) ")
  WriteStringN(scanner\fileoutputchannel, "  scanner\token\tokentype = #anychar ")
  WriteStringN(scanner\fileoutputchannel, "  ProcedureReturn 1")
  WriteStringN(scanner\fileoutputchannel, "EndProcedure ")
  WriteStringN(scanner\fileoutputchannel, " ")
  WriteStringN(scanner\fileoutputchannel, "Procedure.i TESTTOKEN(stoken.s)")
  WriteStringN(scanner\fileoutputchannel, "  scanner\line_s = Trim(scanner\line_s)")
  WriteStringN(scanner\fileoutputchannel, "  If scanner\line_s = "+Chr(34)+Chr(34)+"")
  WriteStringN(scanner\fileoutputchannel, "    ProcedureReturn -100 ")
  WriteStringN(scanner\fileoutputchannel, "  EndIf")
  WriteStringN(scanner\fileoutputchannel, "  Protected counter.i = Len(stoken)")
  WriteStringN(scanner\fileoutputchannel, "  If Mid(scanner\line_s, 1, counter) = stoken")
  WriteStringN(scanner\fileoutputchannel, "    scanner\token\token = Mid(scanner\line_s, 1, counter)")
  WriteStringN(scanner\fileoutputchannel, "    scanner\line_s = Mid(scanner\line_s, counter+1, Len(scanner\line_s)) ")
  WriteStringN(scanner\fileoutputchannel, "    scanner\columncount = Len(scanner\line_s)")
  WriteStringN(scanner\fileoutputchannel, "    ProcedureReturn counter")
  WriteStringN(scanner\fileoutputchannel, "  EndIf")
  WriteStringN(scanner\fileoutputchannel, "  ProcedureReturn -55")
  WriteStringN(scanner\fileoutputchannel, "EndProcedure ")
  WriteStringN(scanner\fileoutputchannel, " ")
  WriteStringN(scanner\fileoutputchannel, "Procedure.i COLLECTTO(CollectChars.s)")
  WriteStringN(scanner\fileoutputchannel, "  scanner\line_s = Trim(scanner\line_s)")
  WriteStringN(scanner\fileoutputchannel, "  If scanner\line_s = "+Chr(34)+Chr(34)+"")
  WriteStringN(scanner\fileoutputchannel, "    ProcedureReturn -100 ")
  WriteStringN(scanner\fileoutputchannel, "  EndIf")
  WriteStringN(scanner\fileoutputchannel, "  scanner\token\token = "+Chr(34)+Chr(34)+"")
  WriteStringN(scanner\fileoutputchannel, "  Repeat ")
  WriteStringN(scanner\fileoutputchannel, "    If scanner\line_s = "+Chr(34)+Chr(34)+"")
  WriteStringN(scanner\fileoutputchannel, "      ProcedureReturn -100 ")
  WriteStringN(scanner\fileoutputchannel, "    EndIf")
  WriteStringN(scanner\fileoutputchannel, "    Protected counter.i = FindString(scanner\line_s, CollectChars, #PB_String_CaseSensitive) ")
  WriteStringN(scanner\fileoutputchannel, "    If counter > 0 ")
  WriteStringN(scanner\fileoutputchannel, "      scanner\line_s = Mid(scanner\line_s, counter + Len(CollectChars), Len(scanner\line_s)) ")
  WriteStringN(scanner\fileoutputchannel, "      scanner\token\token = scanner\token\token + Mid(scanner\line_s, 1, counter)")
  WriteStringN(scanner\fileoutputchannel, "      Break")
  WriteStringN(scanner\fileoutputchannel, "    EndIf")
  WriteStringN(scanner\fileoutputchannel, "    scanner\token\token = scanner\token\token + scanner\line_s ")
  WriteStringN(scanner\fileoutputchannel, "    scanner\line_s = "+Chr(34)+Chr(34)+" ")
  WriteStringN(scanner\fileoutputchannel, "  ForEver")
  WriteStringN(scanner\fileoutputchannel, "  scanner\columncount = Len(scanner\line_s)")
  WriteStringN(scanner\fileoutputchannel, "  scanner\token\tokentype = #collect ")
  WriteStringN(scanner\fileoutputchannel, "  ProcedureReturn Len(scanner\token\token) ")
  WriteStringN(scanner\fileoutputchannel, "EndProcedure ")
EndProcedure

Procedure.s FindDuplicateRulenames(ruledefinition.s)
  Protected.i f=0, location = FindString(ruledefinition, "(")
  If location > 0
    Protected.s comp, rulename = Mid(ruledefinition, 1, location-1)
    ResetMap(meta_scanner::prototypes())
    While NextMapElement(meta_scanner::prototypes())
      comp = Mid(meta_scanner::prototypes(), 1, location-1)
      If comp = rulename
        f = 1
        Break
      EndIf
    Wend
    If f=1
      ProcedureReturn rulename
    EndIf
    ProcedureReturn ""
  EndIf
EndProcedure

Declare.i elem()
Declare.i entry()
Declare.i stmt()
Declare.i prog()
Declare.i elem2()
Declare.i typ1()
Declare.i typ2() 
Declare.i expr()
Declare.i elemxp()
Declare.i entry2()
Declare.i too()
Declare.i zero()
Declare.i codes()
Declare.i getcode()
Declare.i recurs()
Declare.i look()
Declare.i errtext()
Declare.i nexts()
Declare.i prim()
Declare.i snm()
Declare.i labels()
Declare.i SEM1()
Declare.i SEM_a1()
Declare.i SEM_b1()
Declare.i SEM2()
Declare.i SEM3()
Declare.i SEM4()
Declare.i SEM5()
Declare.i SEM6()
Declare.i SEM7()
Declare.i SEM8()
Declare.i SEM9()
Declare.i SEM10()
Declare.i SEM10a()
Declare.i SEM10b()
Declare.i SEM10c()
Declare.i SEM11()
Declare.i SEM12()
Declare.i SEM13()
Declare.i SEM14()
Declare.i SEM15()
Declare.i SEM16()
Declare.i SEM17()
Declare.i SEM17a()
Declare.i SEM18()
Declare.i SEM19()
Declare.i SEM20()
Declare.i SEM21()
Declare.i SEM22()
Declare.i SEM22a()
Declare.i SEM23()
Declare.i SEM25()
Declare.i SEM26()
Declare.i SEM27()
Declare.i SEM30()
Declare.i EMPTY()
Declare.i callheader()
Declare.i SEM100()
Declare.i SEM101()

Global.s prototypestring = "", duplicate = ""

Procedure.i prog()
  Protected  perr.i
  PrintN("MetaPi Compiler @RKO 2015")
  FLUSH()
  FLUSH()
  perr = stmt()
  If perr < 0 
    Goto metapi0 ;ProcedureReturn perr
  EndIf
 metapi1:
  perr = stmt()
  If perr < 0  
    Goto metapi2
  EndIf
  Goto metapi1
 metapi2:
  perr = TESTTOKEN("#END")
metapi0:  
  If perr < 0  ;;;;; some error handling
    ConsoleColor(4, 0)
    WriteStringN(scanner\fileoutputchannel,"Error: in line " + Str(scanner\linecount))
    ConsoleColor(2, 0)
    WriteStringN(scanner\fileoutputchannel,scanner\org_line)
    WriteStringN(scanner\fileoutputchannel,Space((Len(scanner\org_line) - Len(scanner\line_s)))+"^")
    ConsoleColor(14, 0)
    PrintN("Error: in line " + Str(scanner\linecount))
    PrintN(scanner\org_line)
    PrintN(Space((Len(scanner\org_line) - Len(scanner\line_s)))+"^")
    ConsoleColor(2, 0)
    ;Goto metapi1
  EndIf
  ConsoleColor(14, 0)
  PrintN("Done compiling " + Str(scanner\linecount) + " lines of BNF")
  ConsoleColor(2, 0)
  PrintN("Hit Enter to end the program")
  ProcedureReturn perr
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i pointerheader()
  Protected perr.i = 0
  perr = TESTTOKEN("*")
  If perr < 0
    Goto new1
  EndIf
  SEM_a1()
  perr = GETANID()
  If perr < 0
    Goto new1
  EndIf
  SEM_a1()
  perr = TESTTOKEN(".")
  If perr < 0
    Goto new1
  EndIf
  SEM_a1()
  perr = TESTTOKEN("integer")
  If perr < 0
    Goto new3
  EndIf
new3: 
  If perr > 0
    Goto new2
  EndIf
  perr = TESTTOKEN("string")
  If perr < 0
    Goto new4
  EndIf
new4: 
  If perr > 0
    Goto new2
  EndIf
  perr = TESTTOKEN("double")
  If perr < 0
    Goto new5
  EndIf
new5: 
  If perr > 0
    Goto new2
  EndIf
  perr = TESTTOKEN("Float")
  If perr < 0
    Goto new6
  EndIf
new6: 
  If perr > 0
    Goto new2
  EndIf
  perr = TESTTOKEN("Quad")
  If perr < 0
    Goto new7
  EndIf
new7: 
  If perr > 0
    Goto new2
  EndIf
  perr = TESTTOKEN("Unicode")
  If perr < 0
    Goto new8
  EndIf
new8: 
  If perr > 0
    Goto new2
  EndIf
  perr = TESTTOKEN("Character")
  If perr < 0
    Goto new9
  EndIf
new9: 
  If perr > 0
    Goto new2
  EndIf
  perr = TESTTOKEN("byte")
  If perr < 0
    Goto new10
  EndIf
new10: 
  If perr > 0
    Goto new2
  EndIf
  perr = TESTTOKEN("Ascii")
  If perr < 0
    Goto new11
  EndIf
new11: 
  If perr > 0
    Goto new2
  EndIf
  perr = GETANID()
  If perr < 0
    Goto new12
  EndIf
new12: 
new2: 
  If perr < 0
    Goto new1
  EndIf
  SEM_a1()
new13:
  If perr < 0
    Goto new14
  EndIf
  perr = TESTTOKEN(",")
  If perr < 0
    Goto new16
  EndIf
  SEM_a1()
  perr = TESTTOKEN("*")
  If perr < 0
    Goto new16
  EndIf
  SEM_a1()
  perr = GETANID()
  If perr < 0
    Goto new16
  EndIf
  SEM_a1()
  perr = TESTTOKEN(".")
  If perr < 0
    Goto new16
  EndIf
  SEM_a1()
  perr = TESTTOKEN("integer")
  If perr < 0
    Goto new18
  EndIf
new18: 
  If perr > 0
    Goto new17
  EndIf
  perr = TESTTOKEN("string")
  If perr < 0
    Goto new19
  EndIf
new19: 
  If perr > 0
    Goto new17
  EndIf
  perr = TESTTOKEN("double")
  If perr < 0
    Goto new20
  EndIf
new20: 
  If perr > 0
    Goto new17
  EndIf
  perr = TESTTOKEN("Float")
  If perr < 0
    Goto new21
  EndIf
new21: 
  If perr > 0
    Goto new17
  EndIf
  perr = TESTTOKEN("Quad")
  If perr < 0
    Goto new22
  EndIf
new22: 
  If perr > 0
    Goto new17
  EndIf
  perr = TESTTOKEN("Unicode")
  If perr < 0
    Goto new23
  EndIf
new23: 
  If perr > 0
    Goto new17
  EndIf
  perr = TESTTOKEN("Character")
  If perr < 0
    Goto new24
  EndIf
new24: 
  If perr > 0
    Goto new17
  EndIf
  perr = TESTTOKEN("byte")
  If perr < 0
    Goto new25
  EndIf
new25: 
  If perr > 0
    Goto new17
  EndIf
  perr = TESTTOKEN("Ascii")
  If perr < 0
    Goto new26
  EndIf
new26: 
  If perr > 0
    Goto new17
  EndIf
  perr = GETANID()
  If perr < 0
    Goto new27
  EndIf
new27: 
new17: 
  If perr < 0
    Goto new16
  EndIf
  SEM_a1()
new16: 
new15: 
  If perr < 0
    Goto new28
  EndIf
new28: 
  Goto new13
new14:
  perr = 1
  ProcedureReturn perr 
new1:
  ProcedureReturn perr 
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i regularheader()
  Protected perr.i = 0
  perr = GETANID()
  If perr < 0
    Goto new29
  EndIf
  SEM_a1()
  perr = TESTTOKEN(".")
  If perr < 0
    Goto new29
  EndIf
  SEM_a1()
  perr = TESTTOKEN("i")
  If perr < 0
    Goto new31
  EndIf
new31: 
  If perr > 0
    Goto new30
  EndIf
  perr = TESTTOKEN("s")
  If perr < 0
    Goto new32
  EndIf
new32: 
  If perr > 0
    Goto new30
  EndIf
  perr = TESTTOKEN("d")
  If perr < 0
    Goto new33
  EndIf
new33: 
  If perr > 0
    Goto new30
  EndIf
  perr = TESTTOKEN("f")
  If perr < 0
    Goto new34
  EndIf
new34: 
  If perr > 0
    Goto new30
  EndIf
  perr = TESTTOKEN("q")
  If perr < 0
    Goto new35
  EndIf
new35: 
  If perr > 0
    Goto new30
  EndIf
  perr = TESTTOKEN("u")
  If perr < 0
    Goto new36
  EndIf
new36: 
  If perr > 0
    Goto new30
  EndIf
  perr = TESTTOKEN("c")
  If perr < 0
    Goto new37
  EndIf
new37: 
  If perr > 0
    Goto new30
  EndIf
  perr = TESTTOKEN("b")
  If perr < 0
    Goto new38
  EndIf
new38: 
  If perr > 0
    Goto new30
  EndIf
  perr = TESTTOKEN("a")
  If perr < 0
    Goto new39
  EndIf
new39: 
new30: 
  If perr < 0
    Goto new29
  EndIf
  SEM_a1()
new40:
  If perr < 0
    Goto new41
  EndIf
  perr = TESTTOKEN(",")
  If perr < 0
    Goto new43
  EndIf
  SEM_a1()
  perr = GETANID()
  If perr < 0
    Goto new43
  EndIf
  SEM_a1()
  perr = TESTTOKEN(".")
  If perr < 0
    Goto new43
  EndIf
  SEM_a1()
  perr = TESTTOKEN("i")
  If perr < 0
    Goto new45
  EndIf
new45: 
  If perr > 0
    Goto new44
  EndIf
  perr = TESTTOKEN("s")
  If perr < 0
    Goto new46
  EndIf
new46: 
  If perr > 0
    Goto new44
  EndIf
  perr = TESTTOKEN("d")
  If perr < 0
    Goto new47
  EndIf
new47: 
  If perr > 0
    Goto new44
  EndIf
  perr = TESTTOKEN("f")
  If perr < 0
    Goto new48
  EndIf
new48: 
  If perr > 0
    Goto new44
  EndIf
  perr = TESTTOKEN("q")
  If perr < 0
    Goto new49
  EndIf
new49: 
  If perr > 0
    Goto new44
  EndIf
  perr = TESTTOKEN("u")
  If perr < 0
    Goto new50
  EndIf
new50: 
  If perr > 0
    Goto new44
  EndIf
  perr = TESTTOKEN("c")
  If perr < 0
    Goto new51
  EndIf
new51: 
  If perr > 0
    Goto new44
  EndIf
  perr = TESTTOKEN("b")
  If perr < 0
    Goto new52
  EndIf
new52: 
  If perr > 0
    Goto new44
  EndIf
  perr = TESTTOKEN("a")
  If perr < 0
    Goto new53
  EndIf
new53: 
new44: 
  If perr < 0
    Goto new43
  EndIf
  SEM_a1()
new43: 
new42: 
  If perr < 0
    Goto new54
  EndIf
new54: 
  Goto new40
new41:
  perr = 1
  ProcedureReturn perr 
new29:
  ProcedureReturn perr 
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i stmt()
  Protected perr.i = 0
  perr = GETANID()
  If perr < 0
    Goto new55
  EndIf
  SEM_a1()
  perr = TESTTOKEN("(")
  If perr < 0
    Goto new57
  EndIf
  SEM_a1()
  perr = pointerheader()
  If perr < 0
    Goto new59
  EndIf
new59: 
  If perr > 0
    Goto new58
  EndIf
  perr = regularheader()
  If perr < 0
    Goto new60
  EndIf
new60: 
new58: 
  If perr < 0
    Goto new57
  EndIf
new61:
  If perr < 0
    Goto new62
  EndIf
  perr = pointerheader()
  If perr < 0
    Goto new64
  EndIf
new64: 
  If perr > 0
    Goto new63
  EndIf
  perr = regularheader()
  If perr < 0
    Goto new65
  EndIf
new65: 
new63: 
  If perr < 0
    Goto new66
  EndIf
new66: 
  Goto new61
new62:
  perr = 1
  perr = TESTTOKEN(")")
  If perr < 0
    Goto new57
  EndIf
  SEM_a1()
  SEM_b1()
new57: 
  If perr > 0
    Goto new56
  EndIf
  SEM1()
  perr = 1
new67: 
new56: 
  If perr < 0
    Goto new55
  EndIf
  perr = TESTTOKEN(":=")
  If perr < 0
    Goto new55
  EndIf
  perr = entry()
  If perr < 0
    Goto new55
  EndIf
new68:
  If perr < 0
    Goto new69
  EndIf
  perr = TESTTOKEN("|")
  If perr < 0
    Goto new71
  EndIf
  perr = entry()
  If perr < 0
    Goto new71
  EndIf
new71: 
new70: 
  If perr < 0
    Goto new72
  EndIf
new72: 
  Goto new68
new69:
  perr = 1
  SEM4()
  SYNCTO(";");
  perr = TESTTOKEN(";")
new55:
  If duplicate <> ""
    ConsoleColor(7, 0)
    Print("Warning: duplicate rule definition: ") : PrintN(duplicate)
    ConsoleColor(2, 0)
    duplicate = ""
  EndIf  
  ProcedureReturn perr 
EndProcedure

Procedure.i entry()
  Protected  perr.i
  perr = elem()
  If perr < 0  
    ProcedureReturn perr 
  EndIf
 MetaPi11:
 If perr < 0  
   Goto MetaPi12
  EndIf
  perr = elem2()
  Goto MetaPi11
 MetaPi12:
  perr = 1
  SEM6()
  ProcedureReturn perr
EndProcedure

Procedure.i elem()
  Protected  perr.i
  perr = typ1()
  If perr < 0
   Goto MetaPi14
  EndIf
  perr = SEM8()
  ProcedureReturn perr
  MetaPi14:
  perr = typ2()
  If perr < 0
   Goto MetaPi15
  EndIf
  perr = SEM2()
  ProcedureReturn perr
  MetaPi15:
  perr = prim()
  If perr < 0 
    ProcedureReturn perr
   EndIf
  SEM8()
  ProcedureReturn perr
EndProcedure

Procedure.i elem2()
  Protected  perr.i
  perr = typ1()
  If perr < 0
   Goto MetaPi17
  EndIf
  ProcedureReturn perr
  MetaPi17:
  perr = typ2()
  If perr < 0
   Goto MetaPi18
  EndIf
  SEM5()
  ProcedureReturn 0
  MetaPi18:
  perr = prim()
  ProcedureReturn perr
EndProcedure

Procedure.i typ1()
  Protected  perr.i
  perr = codes()
  If perr < 0
   Goto NEW22
  EndIf
  ProcedureReturn perr
  NEW22:
  perr = too()
  If perr < 0
   Goto NEW23
  EndIf
  ProcedureReturn perr
  NEW23:
  perr = recurs()
  If perr < 0
   Goto NEW24
  EndIf
  ProcedureReturn perr
  NEW24:
  perr = getcode()
  If perr < 0
   Goto NEW25
  EndIf
  ProcedureReturn perr
  NEW25:
  perr = NEXTs()
  If perr < 0
   Goto NEW26
  EndIf
  ProcedureReturn perr
  NEW26:
  perr = snm()
  If perr < 0
   Goto NEW27
  EndIf
  ProcedureReturn perr
  NEW27:
  perr = labels()
  If perr < 0
   Goto NEW28
  EndIf
  ProcedureReturn perr
  NEW28:
  perr = look()
  If perr < 0
   Goto NEW29
  EndIf
  ProcedureReturn perr
  NEW29:
  perr = zero()
  If perr < 0
   Goto NEW30
  EndIf
  ProcedureReturn perr
  NEW30:
  ProcedureReturn perr
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i nontermheader()
  Protected perr.i = 0
  perr = TESTTOKEN("@")
  If perr < 0
    Goto mh2
  EndIf
  SEM13()
mh2: 
  If perr > 0
    Goto mh1
  EndIf
  perr = TESTTOKEN("*")
  If perr < 0
    Goto mh3
  EndIf
  SEM13()
mh3: 
  perr = 1
mh1:
  perr = GETANID()
  If perr < 0
    Goto mh6
  EndIf
mh6: 
  If perr > 0
    Goto mh5
  EndIf
  perr = GETINT()
  If perr < 0
    Goto mh7
  EndIf
mh7: 
  If perr > 0
    Goto mh5
  EndIf
  perr = GETSTRING()
  If perr < 0
    Goto mh8
  EndIf
mh8: 
  If perr > 0
    Goto mh5
  EndIf
  perr = GETREAL()
  If perr < 0
    Goto mh9
  EndIf
mh9: 
mh5: 
  If perr < 0
    Goto mh4
  EndIf
  SEM13()
mh10:
  If perr < 0
    Goto mh11
  EndIf
  perr = TESTTOKEN(",")
  If perr < 0
    Goto mh13
  EndIf
  SEM13()
  perr = TESTTOKEN("@")
  If perr < 0
    Goto mh15
  EndIf
  SEM13()
mh15: 
  If perr > 0
    Goto mh14
  EndIf
  perr = TESTTOKEN("*")
  If perr < 0
    Goto mh16
  EndIf
  SEM13()
mh16: 
  perr = 1
mh14:
  perr = GETANID()
  If perr < 0
    Goto mh18
  EndIf
mh18: 
  If perr > 0
    Goto mh17
  EndIf
  perr = GETINT()
  If perr < 0
    Goto mh19
  EndIf
mh19: 
  If perr > 0
    Goto mh17
  EndIf
  perr = GETSTRING()
  If perr < 0
    Goto mh20
  EndIf
mh20: 
  If perr > 0
    Goto mh17
  EndIf
  perr = GETREAL()
  If perr < 0
    Goto mh21
  EndIf
mh21: 
mh17: 
  If perr < 0
    Goto mh13
  EndIf
  SEM13()
mh13: 
mh12: 
  If perr < 0
    Goto mh22
  EndIf
mh22: 
  Goto mh10
mh11:
  perr = 1
  ProcedureReturn perr 
mh4:
  ProcedureReturn perr 
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i typ2()
  Protected perr.i = 0
  perr = expr()
  If perr < 0
    Goto typ221
  EndIf
  ProcedureReturn perr 
typ221:
  perr = GETANID()
  If perr < 0
    Goto typ222
  EndIf
  SEM100()
  perr = TESTTOKEN("(")
  If perr < 0
    Goto typ224
  EndIf
  SEM13()
  perr = nontermheader()
  If perr < 0
    Goto typ224
  EndIf
  perr = TESTTOKEN(")")
  If perr < 0
    Goto typ224
  EndIf
  SEM12()
typ224: 
  If perr > 0
    Goto typ223
  EndIf
  SEM101()
  perr = 1
typ225: 
typ223: 
  If perr < 0
    Goto typ222
  EndIf
  ProcedureReturn perr 
typ222:
  perr = GETSTRING()
  If perr < 0
    Goto typ226
  EndIf
  SEM11()
  ProcedureReturn perr 
typ226:
  perr = TESTTOKEN(".ID")
  If perr < 0
    Goto typ227
  EndIf
  SEM20()
  perr = TESTTOKEN(":")
  If perr < 0
    Goto typ229
  EndIf
  perr = GETANID()
  If perr < 0
    Goto typ229
  EndIf
  SEM30()
typ229: 
  perr = 1
typ228:
  perr = POPSTACK(3)
  ProcedureReturn perr 
typ227:
  perr = TESTTOKEN(".INT")
  If perr < 0
    Goto typ230
  EndIf
  SEM21()
  perr = TESTTOKEN(":")
  If perr < 0
    Goto typ232
  EndIf
  perr = GETANID()
  If perr < 0
    Goto typ232
  EndIf
  SEM30()
typ232: 
  perr = 1
typ231:
  perr = POPSTACK(3)
  ProcedureReturn perr 
typ230:
  perr = TESTTOKEN(".REAL")
  If perr < 0
    Goto typ233
  EndIf
  SEM22a()
  perr = TESTTOKEN(":")
  If perr < 0
    Goto typ235
  EndIf
  perr = GETANID()
  If perr < 0
    Goto typ235
  EndIf
  SEM30()
typ235: 
  perr = 1
typ234:
  perr = POPSTACK(3)
  ProcedureReturn perr 
typ233:
  perr = TESTTOKEN(".GETSTRING")
  If perr < 0
    Goto typ236
  EndIf
  SEM22()
  perr = TESTTOKEN(":")
  If perr < 0
    Goto typ238
  EndIf
  perr = GETANID()
  If perr < 0
    Goto typ238
  EndIf
  SEM30()
typ238: 
  perr = 1
typ237:
  perr = POPSTACK(3)
  ProcedureReturn perr 
typ236:
  perr = TESTTOKEN(".LABEL(")
  If perr < 0
    Goto typ239
  EndIf
  SEM25()
  ProcedureReturn perr 
typ239:
  ProcedureReturn perr 
EndProcedure


Procedure.i expr()
  Protected  perr.i
  perr = TESTTOKEN("(")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  SEM23()
  perr = elemxp()
  If perr < 0 
    ProcedureReturn perr
  EndIf
  perr = TESTTOKEN(")")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  SEM7()
EndProcedure

Procedure.i elemxp()
  Protected  perr.i
  perr = entry2()
  If perr < 0 
    ProcedureReturn perr
  EndIf
  MetaPi35:
  If perr < 0
    Goto  MetaPi36
  EndIf
  perr = TESTTOKEN("|")
  If perr < 0
    Goto  MetaPi39
  EndIf
  SEM3()
  perr = entry2()
  MetaPi39:
   Goto MetaPi35
  MetaPi36:
  perr = 1
  ProcedureReturn perr
EndProcedure

Procedure.i entry2()
  Protected  perr.i
  perr = elem()
  If perr < 0 
    ProcedureReturn perr
  EndIf
  MetaPi41:
  If perr < 0
    Goto  MetaPi42
  EndIf
  perr = elem2()
  Goto MetaPi41
  MetaPi42:
  perr = 1
  SEM7()
  ProcedureReturn perr
EndProcedure

Procedure.i too()
  Protected  perr.i
  perr = TESTTOKEN(".SYNC2")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  perr = TESTTOKEN("(")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  perr = GETSTRING()
  EMIT("  SYNCTO(")
  EMIT("", #FROMOUT)
  EMIT(");")
  perr = TESTTOKEN(")")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i zero()
  Protected  perr.i
  perr = TESTTOKEN("{")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  SEM23()
  perr = elemxp()
  If perr < 0
    Goto  NEWS54
  EndIf
  NEWS54:
  If perr > 0  
    Goto  NEWS53
  EndIf
  perr = 1
  NEWS53:
  perr = TESTTOKEN("}")
  If perr < 0
    Goto  NEWS52
  EndIf
  SEM27()
  ProcedureReturn perr
  NEWS52:
  ProcedureReturn perr
EndProcedure

Procedure.i codes()
  Protected  perr.i
  perr = TESTTOKEN("@@")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  FLUSH()
  EMIT("; START OF USER CODE")
  FLUSH()
  perr = DOCODES("@@")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  EMIT("; END   OF USER CODE")
  FLUSH()
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i getcode()
  Protected  perr.i
  perr = TESTTOKEN(".COLLECT2")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  perr = TESTTOKEN("(")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  perr = GETSTRING()
  EMIT("  COLLECTTO(*inputline, *tok, ")
  EMIT("", #FROMOUT)
  perr = TESTTOKEN(")")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  EMIT(");")
  FLUSH()
  EMIT("  if perr < 0")
  FLUSH()
  EMIT("    ProcedureReturn perr")
  FLUSH()
  EMIT("  endif")
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i recurs()
  Protected  perr.i
  perr = TESTTOKEN("$")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  SEM14()
  perr = elem()
  If perr < 0 
    ProcedureReturn perr
  EndIf
  SEM15()
  ProcedureReturn perr
EndProcedure

Procedure.i look()
  Protected  perr.i
  perr = TESTTOKEN("?")
  If perr < 0
    Goto  NEWS49
  EndIf
  SEM26()
  perr = elem()
  If perr < 0
    Goto NEWS49
  EndIf
  SEM16()
  ProcedureReturn perr
  NEWS49:
  ProcedureReturn perr
EndProcedure

Procedure.i lookzero()
  Protected  perr.i
  perr = TESTTOKEN("?[")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  SEM26()
  SEM23()
  perr = elemxp()
  If perr < 0
    Goto  NEWS54
  EndIf
  NEWS54:
  If perr > 0  
    Goto  NEWS53
  EndIf
  perr = 1
  NEWS53:
  perr = TESTTOKEN("]")
  If perr < 0
    Goto  NEWS52
  EndIf
  SEM16()
  SEM27()
  ProcedureReturn perr
  NEWS52:
  SEM16()
  ProcedureReturn perr
EndProcedure

Procedure.i errtext()
  Protected  perr.i
  perr = TESTTOKEN("<<")
  If perr < 0
    Goto  NEWSs49
  EndIf
  perr = GETSTRING()
  If perr < 0
    Goto NEWSs49
  EndIf
  SEM9()
  perr = TESTTOKEN(",")
  If perr < 0
    Goto NEWSs48
  EndIf
  perr = GETSTRING()
  SEM19()
  If perr < 0
    Goto NEWSs49
  EndIf
  NEWSs48:
  perr = TESTTOKEN(">>")
  ProcedureReturn perr
  NEWSs49:
  ProcedureReturn perr
EndProcedure

Procedure.i nexts()
  Protected  perr.i
  perr = TESTTOKEN(".FLUSH")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  SEM18()
  ProcedureReturn 1
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i callheader()
  Protected perr.i = 0
  perr = TESTTOKEN("@")
  If perr < 0
    Goto prim12
  EndIf
prim12: 
  If perr > 0
    Goto prim11
  EndIf
  perr = TESTTOKEN("*")
  If perr < 0
    Goto prim13
  EndIf
prim13: 
  perr = 1
prim11:
  SEM13()
  perr = GETANID()
  If perr < 0
    Goto prim16
  EndIf
prim16: 
  If perr > 0
    Goto prim15
  EndIf
  perr = GETINT()
  If perr < 0
    Goto prim17
  EndIf
prim17: 
  If perr > 0
    Goto prim15
  EndIf
  perr = GETSTRING()
  If perr < 0
    Goto prim18
  EndIf
prim18: 
  If perr > 0
    Goto prim15
  EndIf
  perr = GETREAL()
prim15: 
  If perr < 0
    Goto prim14
  EndIf
  SEM13()
prim19:
  If perr < 0
    Goto prim110
  EndIf
  perr = TESTTOKEN(",")
  If perr < 0
    Goto prim112
  EndIf
  SEM13()
  perr = TESTTOKEN("@")
  If perr < 0
    Goto prim114
  EndIf
prim114: 
  If perr > 0
    Goto prim113
  EndIf
  perr = TESTTOKEN("*")
  If perr < 0
    Goto prim115
  EndIf
prim115: 
  perr = 1
prim113:
  SEM13()
  perr = GETANID()
  If perr < 0
    Goto prim117
  EndIf
prim117: 
  If perr > 0
    Goto prim116
  EndIf
  perr = GETINT()
  If perr < 0
    Goto prim118
  EndIf
prim118: 
  If perr > 0
    Goto prim116
  EndIf
  perr = GETSTRING()
  If perr < 0
    Goto prim119
  EndIf
prim119: 
  If perr > 0
    Goto prim116
  EndIf
  perr = GETREAL()
prim116: 
  If perr < 0
    Goto prim112
  EndIf
  SEM13()
prim112: 
prim111: 
  If perr < 0
    Goto prim120
  EndIf
prim120: 
  Goto prim19
prim110:
  perr = 1
  ProcedureReturn perr 
prim14:
  ProcedureReturn perr 
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i prim()
  Protected perr.i = 0
  perr = TESTTOKEN(".")
  If perr < 0
    Goto prim91
  EndIf
  perr = GETANID()
  If perr < 0
    Goto prim91
  EndIf
  SEM17()
  perr = TESTTOKEN("(")
  If perr < 0
    Goto prim93
  EndIf
  ;SEM13()
  perr = callheader()
  If perr < 0
    Goto prim93
  EndIf
prim94:
  If perr < 0
    Goto prim95
  EndIf
  perr = TESTTOKEN(",")
  If perr < 0
    Goto prim97
  EndIf
  SEM13()
  perr = callheader()
  If perr < 0
    Goto prim97
  EndIf
prim97: 
prim96: 
  If perr < 0
    Goto prim98
  EndIf
prim98: 
  Goto prim94
prim95:
  perr = 1
  perr = TESTTOKEN(")")
  If perr < 0
    Goto prim93
  EndIf
  SEM12()
prim93: 
  If perr > 0
    Goto prim92
  EndIf
  perr = 1
prim92: 
  If perr < 0
    Goto prim91
  EndIf
  ProcedureReturn perr 
prim91:
  ProcedureReturn perr 
EndProcedure
Last edited by startup on Sun Oct 18, 2015 2:18 am, edited 2 times in total.
Top
startup
Enthusiast
Enthusiast
Posts: 105
Joined: Wed Feb 25, 2015 5:55 pm

Re: meta pi compiler compiler

Post by startup »

part 2 of source code, paste after the the above into one file

Code: Select all

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.i snm()
  Protected perr.i = 0
  perr = TESTTOKEN("SEM")
  If perr < 0
    Goto mh1
  EndIf
  SEM10a()
  perr = TESTTOKEN("_")
  If perr < 0
    Goto mh3
  EndIf
mh3: 
  If perr > 0
    Goto mh2
  EndIf
  perr = GETANID()
  If perr < 0
    Goto mh4
  EndIf
mh4: 
  If perr > 0
    Goto mh2
  EndIf
  perr = GETINT()
  If perr < 0
    Goto mh5
  EndIf
mh5: 
mh2: 
  If perr < 0
    Goto mh1
  EndIf
  SEM10b()
mh6:
  If perr < 0
    Goto mh7
  EndIf
  perr = TESTTOKEN("_")
  If perr < 0
    Goto mh10
  EndIf
mh10: 
  If perr > 0
    Goto mh9
  EndIf
  perr = GETANID()
  If perr < 0
    Goto mh11
  EndIf
mh11: 
  If perr > 0
    Goto mh9
  EndIf
  perr = GETINT()
  If perr < 0
    Goto mh12
  EndIf
mh12: 
mh9: 
  If perr < 0
    Goto mh13
  EndIf
  SEM10b()
mh13: 
mh8: 
  If perr < 0
    Goto mh14
  EndIf
mh14: 
  Goto mh6
mh7:
  perr = 1
  SEM10c()
  ProcedureReturn perr 
mh1:
  ProcedureReturn perr 
EndProcedure

Procedure.i labels()
  Protected  perr.i
  perr = TESTTOKEN(".LABEL(")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  EMIT("  LABEL(")
  perr = GETANID()
  EMIT("", #FROMOUT)
  perr = TESTTOKEN(",")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  EMIT(",")
  perr = GETANID()
  EMIT("", #FROMOUT)
  perr = TESTTOKEN(")")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  EMIT(")")
  FLUSH()
  ProcedureReturn perr
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Procedure.i SEM1()
  Protected  perr.i = 0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM1")
  EndIf
  EMIT(";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")
  FLUSH()
  EMIT("Procedure.i ")
  EMIT("", #FROMOUT)
  prototypestring = scanner\token\token + "()"
  duplicate = FindDuplicateRulenames(prototypestring)
  meta_scanner::prototypes(scanner\token\token) = prototypestring ; scanner\token\token + "()"
  EMIT("()")
  FLUSH()
  EMIT("  Protected perr.i = 0")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM1")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM_a1()
  Protected  perr.i = 0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM1")
  EndIf
  prototypestring = prototypestring + scanner\token\token
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM1")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM_b1()
  Protected  perr.i = 0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM1")
  EndIf
  EMIT(";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")
  FLUSH()
  duplicate = FindDuplicateRulenames(prototypestring)
  meta_scanner::prototypes(prototypestring) = prototypestring
  EMIT("Procedure.i ")
  EMIT(prototypestring)
  FLUSH()
  EMIT("  Protected perr.i = 0")
  FLUSH()
  prototypestring = ""
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM1")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM2()
  Protected  perr.i = 0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM2")
  EndIf
  EMIT("  IF perr < 0")
  FLUSH()
  EMIT("    GOTO ")
  DOLABEL(#DOESNEW, #DOESOUT)
  FLUSH()
  EMIT("  EndIf")
  FLUSH()
  DOLABEL(#DOESPREVIOUS, #DOESSAVE)
  STACKS(#FROMSAVE)
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM2")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM3()
  Protected  perr.i = 0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM3")
  EndIf
  EMIT("  IF perr > 0")
  FLUSH()
  EMIT("    Goto ")
  PEEPSTACK()
  EMIT("", #FROMOUT)
  FLUSH()
  EMIT("  EndIf")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM3")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM4()
  Protected  perr.i = 0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM4")
  EndIf
  prototypestring = "" 
  EMIT("  ProcedureReturn perr ")
  FLUSH()
  EMIT("EndProcedure")
  FLUSH()
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM4")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM5()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM5")
  EndIf
  EMIT("  IF perr < 0")
  FLUSH()
  EMIT("    GOTO ")
  PEEPSTACK()
  EMIT("", #FROMOUT)
  FLUSH()
  EMIT("  EndIf"); , #FROMOUT)
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM5")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM6()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM6")
  EndIf
  EMIT("  ProcedureReturn perr ")
  FLUSH()
  POPSTACK()
  EMIT("", #FROMOUT)
  EMIT(":")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM6")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM7()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM7")
  EndIf
  POPSTACK()
  EMIT("", #FROMOUT)
  EMIT(": ")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM7")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM8()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM8")
  EndIf
  DOLABEL(#DOESNEW, #DOESSAVE)
  STACKS(#FROMSAVE)
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM8")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM9()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM9")
  EndIf
  EMIT("  ErrorText = ")
  EMIT("", #FROMOUT)
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM9")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM10()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM10")
  EndIf
  EMIT("  perr = ")
  EMIT("", #FROMOUT)
  EMIT("()")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM10")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM10a()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM10")
  EndIf
  EMIT("  ") 
  EMIT("", #FROMOUT)
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM10")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM10b()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM10")
  EndIf
  EMIT("", #FROMOUT)
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM10")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM10c()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM10")
  EndIf
  EMIT("()")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM10")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM11()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM11")
  EndIf
  EMIT("  perr = TESTTOKEN(")
  EMIT("", #FROMOUT)
  EMIT(")")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM11")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM12()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM12")
  EndIf
  EMIT("", #FROMOUT)
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM12")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM13()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM13")
  EndIf
  EMIT("", #FROMOUT)
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM13")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM14()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM14")
  EndIf
  DOLABEL(#DOESNEW, #DOESOUT)
  EMIT(":")
  FLUSH()
  DOLABEL(#DOESPREVIOUS, #DOESSAVE)
  STACKS(#FROMSAVE)
  EMIT("  IF perr < 0")
  FLUSH()
  EMIT("    GOTO ")
  DOLABEL(#DOESNEW, #DOESOUT)
  FLUSH()
  EMIT("  EndIf")
  FLUSH()
  DOLABEL(#DOESPREVIOUS, #DOESSAVE)
  STACKS(#FROMSAVE)
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM14")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM15()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM15")
  EndIf
  POPSTACK()
  EMIT("", #FROMOUT)
  EMIT(": ")
  FLUSH()
  EMIT("  GOTO ")
  POPSTACK()
  SAVETEMP()
  POPSTACK()
  EMIT("", #FROMOUT)
  ;EMIT(":")
  FLUSH()
  STACKS(#FROMSAVE)
  POPSTACK()
  EMIT("", #FROMOUT)
  EMIT(":")
  FLUSH()
  EMIT("  perr = 1")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM15")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM16()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM16")
  EndIf
  FLUSH()
  POPSTACK()
  EMIT("", #FROMOUT)
  EMIT(": ")
  FLUSH()
  EMIT("  CopyScannerStructure(@scanner, @tmpscanner)")
  FLUSH()    
  EMIT("  FileSeek(scanner\currentFile, scanner\fileposition)")
  FLUSH()
  EMIT("  if perr < 0")
  FLUSH()
  EMIT("    ProcedureReturn perr")
  FLUSH()
  EMIT("  endif")
  FLUSH()
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM16")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM17() ;;;; . and ID
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM17")
  EndIf
  EMIT("  perr = ")
  EMIT("", #FROMOUT)
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM17")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM17a() ;;;; . and ID
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM17")
  EndIf
  EMIT(")")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM17")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM18()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM18")
  EndIf
  EMIT("  FLUSH()")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM18")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM19()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM19")
  EndIf
  EMIT("  SyncText = ")
  EMIT("", #FROMOUT)
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM19")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM20()
  Protected  perr.i=0
  EMIT("  perr = GETANID()")
  STACKS(#FROMTOKEN, "",#id, 3)
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i SEM21()
  Protected  perr.i=0
  EMIT("  perr = GETINT()")
  STACKS(#FROMTOKEN, "",#integer, 3)
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i SEM22()
  Protected  perr.i=0
  EMIT("  perr = GETSTRING()")
  STACKS(#FROMTOKEN, "",#string, 3)
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i SEM22a()
  Protected  perr.i=0
  EMIT("  perr = GETREAL()")
  STACKS(#FROMTOKEN, "",#float, 3)
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i SEM23()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM23")
  EndIf
  DOLABEL(#DOESNEW, #DOESSAVE)
  STACKS(#FROMSAVE)
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM23")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM25()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM25")
  EndIf
  EMIT("  LABEL(")
  perr = GETANID()
  EMIT("", #FROMOUT)
  perr = TESTTOKEN(",")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  EMIT(",")
  perr = GETANID()
  EMIT("", #FROMOUT)
  perr = TESTTOKEN(")")
  If perr < 0 
    ProcedureReturn perr
  EndIf
  EMIT(")")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM25")
  EndIf
EndProcedure

Procedure.i SEM26()
  Protected  perr.i=0
  EMIT("  CopyScannerStructure(@tmpscanner, @scanner)")
  FLUSH()
  FLUSH()
  ProcedureReturn perr
EndProcedure

Procedure.i SEM27()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM27")
  EndIf
  EMIT("  perr = 1")
  FLUSH()
  POPSTACK()
  EMIT("", #FROMOUT)
  EMIT(":")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM27")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM100()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM10")
  EndIf
  EMIT("  perr = ")
  EMIT("", #FROMOUT)
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM10")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM101()
  Protected  perr.i=0
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              ----SEM10")
  EndIf
  EMIT("()")
  FLUSH()
  If scanner\DEBUGS
     WriteStringN(scanner\fileoutputchannel, "                              END SEM10")
  EndIf
  ProcedureReturn perr
EndProcedure

Procedure.i SEM30()
  Protected  perr.i=0
  EMIT("  Protected ")
  STACKS(#FROMTOKEN, "",#none, 1)
  POPSTACK(1)
  EMIT("", #FROMOUT)
  PEEPSTACK(3)
  Select scanner\token\tokentype
    Case #none, #string
      EMIT(".s")
    Case #integer
      EMIT(".i")
    Case #float
      EMIT(".d")
    Case #id
      EMIT(".s")
    Case #anychar
      EMIT(".c")
    Case #code
      EMIT(".s")
    Case #collect
      EMIT(".s")
  EndSelect   
  EMIT(" = ")
  POPSTACK(3)
  Select scanner\token\tokentype
    Case #none
      EMIT(" scanner\token\token")
    Case #string
      EMIT("chr(34)+") : EMIT("scanner\token\token") : EMIT("+chr(34)")
    Case #integer
      EMIT(" val(scanner\token\token)")
    Case #float
      EMIT(" vald(scanner\token\token)")
    Case #id
      EMIT(" scanner\token\token")
    Case #anychar
      EMIT(" scanner\token\token")
    Case #code
      EMIT(" scanner\token\token")
    Case #collect
      EMIT(" scanner\token\token")
  EndSelect     
  FLUSH()
  ProcedureReturn perr
EndProcedure

Global.s outfil1, outfil, ins, scannerout = ""

Procedure CREATES(in.s, out.s)
  outfil1=out
  outfil=out
  scanner\fileinputchannel  = OpenFile(#PB_Any, in, #PB_File_SharedRead )
  scanner\fileoutputchannel = CreateFile(#PB_Any, out+".tmp")
  meta_scanner::protoypeFile= out
  scanner\largestColumn     = 0
  scanner\labelnumber       = 0
  scanner\libInProgress     = 0
  scanner\currentFile       = scanner\fileinputchannel
  scanner\mainInputFile     = scanner\fileinputchannel
  scanner\fileposition      = Loc(scanner\fileinputchannel)
  scanner\doingCode         = #False
  scanner\doingTrace        = #False
  scanner\doingToScreen     = #True
  scanner\mainIsSet         = #False
  scanner\LabelName         = "METAPI"
  scanner\DEBUGS            = #False
  scanner\line_s            = ""
  scanner\org_line          = ""
  scanner\token\tokentype   = #none
  scanner\token\token       = ""
  Protected i.i
  For i = 0 To #MAXSTACKS
    scanner\stackpointer(i) = 0
  Next
  meta_scanner::protoypeFile = GetFilePart(meta_scanner::protoypeFile, #PB_FileSystem_NoExtension)    
EndProcedure

OpenConsole("MetaPi Compiler @RKO")
ConsoleColor(2, 0)
ins = ProgramParameter()
outfil = ProgramParameter()
scannerout = ProgramParameter()
If Len(Trim(ins)) <= 0
  PrintN("Meta Input File Missing")
  PrintN("")
  ConsoleColor(14, 0)
  PrintN("Call Metacompiler with:")
  PrintN("infilename")
  PrintN("optinal outfilename")
  PrintN("")
  ConsoleColor(2, 0)
  PrintN("Hit Enter to end the program")
  Input()
  CloseConsole()
  End
EndIf
If Len(Trim(outfil)) <= 0
  ConsoleColor(14, 0)
  PrintN("Ouput File Missing - assuming as name:  metaout.pb")
  ConsoleColor(2, 0)
  outfil = "metaout.pb"
Else
  If Len(GetExtensionPart(outfil)) <= 0
    outfil+".pb"
  EndIf
EndIf

CREATES(ins, outfil)
prog()
If scanner\mainName <> ""
  WriteStringN(scanner\fileoutputchannel, "")
  WriteStringN(scanner\fileoutputchannel, ";;;;;;;;;;;;; MAIN to call")
  If FindString(scanner\mainName, "(") 
    WriteStringN(scanner\fileoutputchannel, scanner\mainName)
  Else
    WriteStringN(scanner\fileoutputchannel, scanner\mainName+"()")
  EndIf
EndIf
CloseFile(scanner\fileoutputchannel)
outfil1 = meta_scanner::protoypeFile + "_inc.pbi"
scanner\fileoutputchannel = CreateFile(#PB_Any, outfil1)
If LCase(scannerout) = "/scanner"
  WriteStringN(scanner\fileoutputchannel, "")
  WriteStringN(scanner\fileoutputchannel, ";;;;;;;;;;;;;; Minimal Scanner ;;;;;;;;;;;;;;;;")
  WriteStringN(scanner\fileoutputchannel, "")
  WriteScanner()
EndIf
WriteStringN(scanner\fileoutputchannel, "")
WriteStringN(scanner\fileoutputchannel, "")
WriteStringN(scanner\fileoutputchannel, ";;;;;;;;;;;;;; Parser Declares ;;;;;;;;;;;;;;;;")
ResetMap(meta_scanner::prototypes())
While NextMapElement(meta_scanner::prototypes())
  WriteStringN(scanner\fileoutputchannel, "Declare.i " + meta_scanner::prototypes())
Wend
CloseFile(scanner\fileoutputchannel)
scanner\fileoutputchannel = CreateFile(#PB_Any, outfil)
scanner\fileinputchannel  = OpenFile(#PB_Any, outfil1, #PB_File_SharedRead )
WriteStringN(scanner\fileoutputchannel, "; Created with: MetaPi Compiler @RKO 2015")
WriteStringN(scanner\fileoutputchannel, "")
While Eof(scanner\fileinputchannel) = 0  
  WriteStringN(scanner\fileoutputchannel, ReadString(scanner\fileinputchannel))
Wend
CloseFile(scanner\fileinputchannel)
scanner\fileinputchannel  = OpenFile(#PB_Any, outfil+".tmp", #PB_File_SharedRead )
While Eof(scanner\fileinputchannel) = 0  
  WriteStringN(scanner\fileoutputchannel, ReadString(scanner\fileinputchannel))
Wend
CloseFile(scanner\fileinputchannel)
CloseFile(scanner\fileoutputchannel)
DeleteFile(outfil+".tmp", #PB_FileSystem_Force)
DeleteFile(outfil1, #PB_FileSystem_Force)
FreeMap(prototypes())
Input()
CloseConsole()
Last edited by startup on Sun Oct 18, 2015 2:13 am, edited 1 time in total.
Top
startup
Enthusiast
Enthusiast
Posts: 105
Joined: Wed Feb 25, 2015 5:55 pm

Re: meta pi compiler compiler

Post by startup »

scanner module:

Code: Select all

DeclareModule meta_scanner
  EnableExplicit
  
  #atEOF          = -10000
  #MAXFILELIBRARIES = 10
  #MAXSTACKS      = 10
  #MAXINSTACK     = 1000
  #GETANIDERROR   = 1
  #TESTTOKENERROR = 2
  #GETINTERROR    = 3
  #GETREALERROR   = 4
  #GETSTRINGERROR = 5
  #GETANYCHARERROR= 6
  #SYNCTOERROR    = 7
  #COLLECTTOERROR = 8
  #CODEERROR      = 11
  #DOESSAVE       = 100
  #DOESOUT        = 101
  #DOESPREVIOUS   = 103
  #DOESNEW        = 104
  #FROMSAVE       = 1
  #FROMTOKEN      = 2
  #FROMOUT        = 3
  #FROMSTRING     = 4
  
  NewMap prototypes.s()
  Global protoypeFile.s = ""

  Enumeration toktype
    #none
    #string
    #integer
    #float
    #id
    #anychar
    #code
    #collect
  EndEnumeration
  
  Structure token
    token.s
    tokentype.i
  EndStructure
  
  Structure scan
   columncount.i
   largestColumn.i
   linecount.i
   fileinputchannel.i
   fileoutputchannel.i
   labelnumber.i
   libInProgress.i
   currentFile.i
   mainInputFile.i
   fileposition.q
   doingCode.i
   doingTrace.i
   doingToScreen.i
   mainIsSet.i
   token.token
   SaveString.s
   LabelName.s
   OutString.s
   inFilename.s
   mainName.s
   DEBUGS.i
   line_s.s
   org_line.s
   Array filelibraries.s(#MAXFILELIBRARIES)
   Array stack.token(#MAXSTACKS,#MAXINSTACK)
   Array stackpointer.i(#MAXSTACKS)
  EndStructure
  
  Global scanner.scan, tmpscanner.scan
  
  Declare   ClearScannerStructure(*p.scan)
  Declare   CopyScannerStructure(*out.scan, *in.scan)
  Declare.i IsWhite(char.s)
  Declare.i IsDigit(char.s)
  Declare.i GETANID()
  Declare.i GETINT()
  Declare.i GETREAL()
  Declare.i GETSTRING()
  Declare.i GETANYCHAR()
  Declare.i DOCODES(untils.s)
  Declare.i TESTTOKEN(stoken.s)
  Declare.i COLLECTTO(CollectChars.s)
  Declare.i GETNOT(NotChar.s)
  Declare.i SYNCTO(SyncChar.s)
  Declare   SAVETEMP(SaveStrings.s = "")
  Declare   DOLABEL(lmode.i, generate.i)
  Declare.i STACKS(fromwhat.i, stringvals.s = "", type.i=#none, whichs.i = 0)
  Declare   POPSTACK(whichs.i = 0)
  Declare   PEEKSTACK(element.i, whichs.i=0)
  Declare   PEEPSTACK(whichs.i=0)
  Declare   EMIT(EmitString.s, whichs.i=0)
  Declare   FLUSH()

EndDeclareModule

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Module meta_scanner
  EnableExplicit
  
  Procedure ClearScannerStructure(*p.scan)
    *p\columncount   = 0
    *p\largestColumn = 0
    *p\linecount     = 0
    *p\fileinputchannel  = 0
    *p\fileoutputchannel = 0
    *p\labelnumber   = 0
    *p\libInProgress = 0
    *p\currentFile   = 0
    *p\mainInputFile = 0
    *p\fileposition  = 0
    *p\doingCode     = #False
    *p\doingTrace    = #False
    *p\doingToScreen = #False
    *p\mainIsSet     = #False
    *p\token\token   = ""
    *p\token\tokentype= #none
    *p\SaveString    = ""
    *p\LabelName     = ""
    *p\OutString     = ""
    *p\inFilename    = ""
    *p\mainName      = ""
    *p\DEBUGS        = #False
    *p\line_s        = ""
    FreeArray(*p\filelibraries())
    Dim *p\filelibraries(#MAXFILELIBRARIES)
    FreeArray(*p\stack())
    Dim *p\stack(#MAXSTACKS, #MAXINSTACK)
    FreeArray(*p\stackpointer())
    *p\stackpointer(#MAXSTACKS)
  EndProcedure
  
  Procedure CopyScannerStructure(*out.scan, *in.scan)
    *out\columncount   =      *in\columncount
    *out\largestColumn =      *in\largestColumn
    *out\linecount     =      *in\linecount
    *out\fileinputchannel  =  *in\fileinputchannel
    *out\fileoutputchannel =  *in\fileoutputchannel
    *out\labelnumber   =      *in\labelnumber
    *out\libInProgress =      *in\libInProgress
    *out\currentFile   =      *in\currentFile
    *out\mainInputFile =      *in\mainInputFile
    *out\fileposition  =      *in\fileposition
    *out\doingCode     =      *in\doingCode
    *out\doingTrace    =      *in\doingTrace
    *out\doingToScreen =      *in\doingToScreen
    *out\mainIsSet     =      *in\mainIsSet
    *out\token\token   =      *in\token\token
    *out\token\tokentype=     *in\token\tokentype
    *out\SaveString    =      *in\SaveString
    *out\LabelName     =      *in\LabelName
    *out\OutString     =      *in\OutString
    *out\inFilename    =      *in\inFilename
    *out\mainName      =      *in\mainName
    *out\DEBUGS        =      *in\DEBUGS
    *out\line_s        =      *in\line_s
    CopyArray(*in\filelibraries(), *out\filelibraries())
    CopyArray(*in\stack(), *out\stack())
    CopyArray(*in\stackpointer(), *out\stackpointer())
  EndProcedure
  
  Procedure.i IsWhite(char.s)
    Select Asc(char)
      Case 32, 0
        ProcedureReturn #True     
      Default
        ProcedureReturn #False
    EndSelect
  EndProcedure
   
  Procedure.i IsDigit(char.s)
    Select Asc(char)
      Case 48 To 57, 46
        ProcedureReturn #True     
      Default
        ProcedureReturn #False
    EndSelect
  EndProcedure
  
  Procedure.i READLINE()
    scanner\line_s = Trim(ReadString(scanner\currentFile))
    scanner\fileposition = Loc(scanner\currentFile)
    scanner\linecount + 1
    scanner\columncount = 1
    scanner\org_line = scanner\line_s
    If scanner\line_s <> "" 
      scanner\columncount = Len(scanner\line_s)
      ProcedureReturn scanner\largestColumn
    Else
      If Eof(scanner\currentFile) 
        scanner\columncount = Len(scanner\line_s)
        ProcedureReturn #atEOF
      EndIf
      scanner\columncount = Len(scanner\line_s)
      ProcedureReturn -1
    EndIf
    scanner\columncount = Len(scanner\line_s)
    ProcedureReturn -1
  EndProcedure
  
  Procedure.i READCARD()
    READCARD1:
    If READLINE() = #atEOF 
      If scanner\libInProgress > 0 
        PrintN("++++++++++ END PARSING LIB " + scanner\filelibraries(scanner\libInProgress))
        CloseFile(scanner\libInProgress)
        scanner\libInProgress - 1
        If scanner\libInProgress = 0 
          scanner\currentFile = scanner\mainInputFile
          scanner\libInProgress = 0
        EndIf
        Goto READCARD1
      Else
        ProcedureReturn #atEOF
      EndIf
    EndIf
    If scanner\doingCode = #False 
      If Left(scanner\line_s, 1) = "#" 
        If Left(scanner\line_s, 4) = "#END" 
          If scanner\libInProgress > 0 
            PrintN("++++++++++ END PARSING LIB " + scanner\filelibraries(scanner\libInProgress))
            CloseFile(scanner\libInProgress)
            scanner\libInProgress - 1
            If scanner\libInProgress = 0 
              scanner\currentFile = scanner\mainInputFile
              scanner\libInProgress = 0
            EndIf
            Goto READCARD1
          Else
            ProcedureReturn #atEOF
          EndIf
          Goto READCARD1
        EndIf
        If Left(scanner\line_s, 5) = "#FILE" 
          If scanner\doingToScreen = #True 
            PrintN("LINE: " +Str(scanner\linecount))
            PrintN(scanner\line_s)
          EndIf
          scanner\line_s = Mid(scanner\line_s, 6,Len(scanner\line_s)) 
          If GETANID() > 0 
            CloseFile(scanner\currentFile)
            scanner\currentFile =  #PB_Any
            OpenFile(scanner\currentFile, scanner\token\token, #PB_File_SharedRead)
            FlushFileBuffers(scanner\fileoutputchannel)
          Else
            PrintN("ERROR in FILE command. Line: " + Str(scanner\linecount))
          EndIf
          Goto READCARD1
        EndIf
        If Left(scanner\line_s, 6) = "#LABEL" 
          If scanner\doingToScreen = #True 
            PrintN("LINE: " +Str(scanner\linecount))
            PrintN(scanner\line_s)
          EndIf
          scanner\line_s = Mid(scanner\line_s, 7,Len(scanner\line_s)) 
          If GETANID() > 0 
            scanner\LabelName = scanner\token\token
            scanner\labelnumber = 0
          EndIf
          Goto READCARD1
        EndIf
        If Left(scanner\line_s, 4) = "#LIB" 
          If scanner\doingToScreen = #True 
            PrintN("LINE: " +Str(scanner\linecount))
            PrintN(scanner\line_s)
          EndIf
          scanner\line_s = Mid(scanner\line_s, 5,Len(scanner\line_s))
          If GETANID() > 0 
            scanner\libInProgress + 1
            scanner\filelibraries(scanner\libInProgress) = scanner\token\token
            OpenFile(scanner\libInProgress, scanner\filelibraries(scanner\libInProgress), #PB_File_SharedRead)
            FlushFileBuffers(scanner\fileoutputchannel)
            scanner\currentFile = scanner\libInProgress
          Else
            PrintN("ERROR in LIB command. Line: " + scanner\linecount)
          EndIf
          Goto READCARD1
        EndIf
        If Left(scanner\line_s, 5) = "#MAIN" 
          scanner\line_s = Trim(Mid(scanner\line_s, 6,Len(scanner\line_s)))
          If Len(scanner\line_s) > 0 ;GETANID() > 0 
            scanner\mainIsSet = #True
            scanner\mainName = scanner\line_s ;scanner\token\token
            scanner\line_s = ""
          EndIf
          If scanner\doingToScreen = #True 
            PrintN("LINE: " +Str(scanner\linecount))
            PrintN(scanner\line_s)
          EndIf
          Goto READCARD1
        EndIf
        If Left(scanner\line_s, 7) = "#SCREEN" 
          If scanner\doingToScreen = #True 
            scanner\doingToScreen = #False
          Else
            scanner\doingToScreen = #True
          EndIf
          Goto READCARD1
        EndIf
        If Left(scanner\line_s, 7) = "#DEBUGS"
          If scanner\DEBUGS = #True 
            scanner\DEBUGS = #False
          Else
            scanner\DEBUGS = #True
          EndIf
          Goto READCARD1
        EndIf
        If Left(scanner\line_s, 6) = "#TRACE" 
          If scanner\doingTrace = #True 
            scanner\doingTrace = #False
          Else
            scanner\doingTrace = #True
          EndIf
          Goto READCARD1
        EndIf
        If Left(scanner\line_s, 2) = "//" 
          Goto READCARD1
        Else
          PrintN("Incorrect ;#; command in file " + scanner\inFilename)
          PrintN(scanner\line_s)
        EndIf
      EndIf
    EndIf
    If (Left(scanner\line_s, 2) = "@@") Or ((FindString(scanner\line_s, "@@") > 0) And scanner\doingCode = #True)
      If scanner\doingCode = #False 
         WriteStringN(scanner\fileoutputchannel, "")
         WriteStringN(scanner\fileoutputchannel, "; START OF USER CODE")
         ;WriteStringN(scanner\fileoutputchannel, "")
         If FindString(scanner\line_s, "@@") < Len(scanner\line_s)
           WriteString(scanner\fileoutputchannel, "  ")
           WriteStringN(scanner\fileoutputchannel, Trim(Mid(scanner\line_s, FindString(scanner\line_s, "@@")+2, Len(scanner\line_s))))
         EndIf
         scanner\doingCode = #True
      Else
         If FindString(scanner\line_s, "@@") > 0
           WriteString(scanner\fileoutputchannel, "  ")
           WriteStringN(scanner\fileoutputchannel, Mid(scanner\line_s, 1, FindString(scanner\line_s, "@@")-1))
           scanner\line_s = Trim(Mid(scanner\line_s, FindString(scanner\line_s, "@@")+2, Len(scanner\line_s)))
         EndIf
         If Trim(scanner\line_s) <> ""
           scanner\columncount = Len(scanner\org_line) - Len(scanner\line_s)
         EndIf
         ;WriteStringN(scanner\fileoutputchannel, "")
         WriteStringN(scanner\fileoutputchannel, "; END   OF USER CODE")
         WriteStringN(scanner\fileoutputchannel, "")
         scanner\doingCode = #False
      EndIf
      Goto READCARD1
    EndIf
    If scanner\doingTrace = #True
       WriteStringN(scanner\fileoutputchannel, ";")
       WriteStringN(scanner\fileoutputchannel, "; "+ scanner\line_s)
       WriteStringN(scanner\fileoutputchannel, ";")
    EndIf
    If scanner\doingToScreen = #True 
      PrintN("LINE: " +Str(scanner\linecount))
      PrintN(scanner\line_s)
      ;PrintN("")
    EndIf
    If scanner\doingCode = #True 
      WriteString(scanner\fileoutputchannel, "  ")
      WriteStringN(scanner\fileoutputchannel, scanner\line_s)
      Goto READCARD1
    EndIf
    If Left(scanner\line_s, 2) = "//" 
      Goto READCARD1
    EndIf
    ProcedureReturn 1
  EndProcedure
  
  Procedure.i SPAN()
    scanner\line_s = Trim(scanner\line_s)
    While scanner\line_s = ""
      If READCARD() = #atEOF
        ProcedureReturn #atEOF
      EndIf
      scanner\line_s = Trim(scanner\line_s)
    Wend
    If scanner\columncount > 1 
      scanner\columncount = Len(scanner\line_s) - scanner\largestColumn
    EndIf
    ProcedureReturn 0
  EndProcedure
  
  Procedure.i GETANID()
    If SPAN() = #atEOF 
      ProcedureReturn (#atEOF|#GETANIDERROR)
    EndIf
    Select Asc(Mid(scanner\line_s, 1, 1))
      Case 65 To 90, 97 To 122, 95
      Default
        ProcedureReturn - #GETANIDERROR
    EndSelect
    scanner\token\token = ""
    Protected counter.i = 1
    While Mid(scanner\line_s, counter, 1) <> #CRLF$
      Select Asc(Mid(scanner\line_s, counter, 1))
        Case 65 To 90, 97 To 122, 48 To 57, 95
          scanner\token\token = scanner\token\token + Mid(scanner\line_s, counter, 1)
          counter + 1
        Default        
          scanner\line_s = Mid(scanner\line_s, counter, Len(scanner\line_s))
          scanner\columncount = Len(scanner\line_s)
          scanner\token\tokentype = #id
          ProcedureReturn counter - 1
          Break
      EndSelect
    Wend
    scanner\token\tokentype = #none
  EndProcedure
  
  Procedure.i GETINT()
    If SPAN() = #atEOF 
      ProcedureReturn (#atEOF|#GETINTERROR)
    EndIf
    Select Asc(Mid(scanner\line_s, 1, 1))
      Case 48 To 57
      Default
        ProcedureReturn -(#GETINTERROR)
    EndSelect
    scanner\token\token = ""
    Protected counter.l = 1
    While Mid(scanner\line_s, counter, 1) <> #CRLF$
      Select Asc(Mid(scanner\line_s, counter, 1))
        Case 48 To 57
          scanner\token\token = scanner\token\token + Mid(scanner\line_s, counter, 1)
          counter + 1 
        Default
          scanner\line_s = Mid(scanner\line_s, counter, Len(scanner\line_s))
          scanner\columncount = Len(scanner\line_s)
          scanner\token\tokentype = #integer
          ProcedureReturn counter-1
      EndSelect
    Wend
    scanner\token\tokentype = #none
  EndProcedure
  
  Procedure.i GETREAL()
    Protected counter.l = 1
    Protected matchPosition.l
    If SPAN() = #atEOF 
      ProcedureReturn -(#atEOF | #GETREALERROR)
    EndIf
    Select Asc(Mid(scanner\line_s, 1, 1))
      Case Asc("0") To Asc("9")
        counter = 1
      Case Asc(".")
        If IsDigit(Mid(scanner\line_s, 1, 1)) 
          counter = 2
        Else
          ProcedureReturn -(#atEOF | #GETREALERROR)
        EndIf          
      Default
        ProcedureReturn -(#atEOF | #GETREALERROR)
    EndSelect
    While Mid(scanner\line_s, counter, 1) <> #CRLF$
      Select  Asc(Mid(scanner\line_s, counter, 1))
        Case Asc("0") To Asc("9")
          scanner\token\token = scanner\token\token + Mid(scanner\line_s, counter, 1)
          counter + 1 
        Default
          counter - 1
          Break
      EndSelect
    Wend
    If Mid(scanner\line_s, counter, 1) <> #CRLF$ 
      If Mid(scanner\line_s, counter+1, 1) = "E" Or Mid(scanner\line_s, counter, 1) = "e" 
        If Mid(scanner\line_s, counter+2, 1) = "+" Or Mid(scanner\line_s, counter, 1) = "-" 
          counter + 2
          scanner\token\token = scanner\token\token + Mid(scanner\line_s, counter, 1)
        Else
          counter + 1
        EndIf
        While Mid(scanner\line_s, counter, 1) <> #CRLF$
          Select  Asc(Mid(scanner\line_s, counter, 1))
            Case Asc("0") To Asc("9")
              scanner\token\token = scanner\token\token + Mid(scanner\line_s, counter, 1)
              counter + 1 
            Default
              counter - 1
              Break
          EndSelect
        Wend
      EndIf
    EndIf
    scanner\token\token = Mid(scanner\line_s, 1, counter)
    scanner\line_s = Mid(scanner\line_s, counter+1, Len(scanner\line_s))
    If counter > 1 
      scanner\columncount = Len(scanner\line_s)
      scanner\token\tokentype = #float
      ProcedureReturn counter
    Else
      scanner\token\tokentype = #none
      ProcedureReturn -(#GETREALERROR)
    EndIf
  EndProcedure
  
  Procedure.i GETSTRING()
    If SPAN() = #atEOF 
      ProcedureReturn (#atEOF|#GETSTRINGERROR)
    EndIf
    If Mid(scanner\line_s, 1, 1) = Chr(34) 
      Protected counter.l = 2
      While Mid(scanner\line_s, counter, 1) <> #CRLF$
        If Mid(scanner\line_s, counter, 1) = Chr(34)
          scanner\token\token = Mid(scanner\line_s, 1, counter)
          counter + 1
          scanner\line_s = Mid(scanner\line_s, counter, Len(scanner\line_s))
          scanner\token\tokentype = #string
          ProcedureReturn counter
        Else
          counter + 1
        EndIf
      Wend
    EndIf
    scanner\token\tokentype = #none
    ProcedureReturn -(#GETSTRINGERROR)
  EndProcedure
  
  Procedure.i GETANYCHAR()
    If scanner\line_s = "" 
      If SPAN() = #atEOF 
        ProcedureReturn (#atEOF|#GETANYCHARERROR)
      EndIf
    EndIf
    scanner\token\token = Mid(scanner\line_s, 1, 1)
    scanner\line_s = Mid(scanner\line_s, 2, 1)
    scanner\token\tokentype = #anychar
    ProcedureReturn 1
  EndProcedure
  
  Procedure.i DOCODES(untils.s)
    Protected counter.l
    Repeat
      If scanner\line_s = "" 
        scanner\line_s = Trim(ReadString(scanner\currentFile))
        scanner\fileposition = Loc(scanner\currentFile)
        scanner\linecount + 1
        scanner\columncount = 1
        scanner\org_line = scanner\line_s
        If Eof(scanner\currentFile)
          ProcedureReturn (#atEOF|#CODEERROR)
        EndIf
      EndIf
      counter = FindString(scanner\line_s, untils)
      If counter > 0 
        WriteStringN(scanner\fileoutputchannel, Mid(scanner\line_s, 1, counter-1))
        scanner\line_s = Mid(scanner\line_s, counter + Len(untils), Len(scanner\line_s)) 
        scanner\columncount = Len(scanner\line_s)
        scanner\token\tokentype = #code
        ProcedureReturn 1
      EndIf
      If scanner\line_s = "#END"
        ProcedureReturn -(#CODEERROR)
      EndIf
      WriteStringN(scanner\fileoutputchannel, scanner\line_s)
      scanner\line_s = ""
    ForEver
    ProcedureReturn -(#CODEERROR)
  EndProcedure
  
  Procedure.i TESTTOKEN(stoken.s)
    If SPAN() = #atEOF 
      ProcedureReturn (#atEOF | #TESTTOKENERROR)
    EndIf
    Protected counter.i = Len(stoken)
    If Mid(scanner\line_s, 1, counter) = stoken 
      scanner\token\token = Mid(scanner\line_s, 1, counter)
      scanner\line_s = Mid(scanner\line_s, counter+1, Len(scanner\line_s)) 
      scanner\columncount = Len(scanner\line_s)
      ProcedureReturn counter
    EndIf
    ProcedureReturn -(#TESTTOKENERROR)
  EndProcedure
  
  Procedure.i COLLECTTO(CollectChars.s)
    scanner\token\token = ""
    Repeat
      If scanner\line_s = "" 
        If SPAN() = #atEOF 
          ProcedureReturn (#atEOF|#COLLECTTOERROR)
        EndIf
      EndIf
      Protected counter.i = FindString(scanner\line_s, CollectChars, #PB_String_CaseSensitive)
      If counter > 0 
        scanner\line_s = Mid(scanner\line_s, counter + Len(CollectChars), Len(scanner\line_s))
        scanner\token\token = scanner\token\token + Mid(scanner\line_s, 1, counter)
        Break
      EndIf
      scanner\token\token = scanner\token\token + scanner\line_s
      scanner\line_s = ""
    ForEver
    scanner\columncount = Len(scanner\line_s)
    scanner\token\tokentype = #collect
    ProcedureReturn Len(scanner\token\token)
  EndProcedure
  
  Procedure.i GETNOT(NotChar.s)
    If COLLECTTO(NotChar) > 0 
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  EndProcedure
  
  Procedure.i SYNCTO(SyncChar.s)
    Protected counter.i = Len(SyncChar)
    Repeat
      If Mid(scanner\line_s, 1, counter) <> SyncChar 
        scanner\line_s = Mid(scanner\line_s, counter+1,Len(scanner\line_s))
        If SPAN() = #atEOF 
          ProcedureReturn (#atEOF | #SYNCTOERROR)
        EndIf
      Else
        scanner\columncount = Len(scanner\line_s)
        ProcedureReturn 1
      EndIf
    ForEver
  EndProcedure
  
  Procedure SAVETEMP(SaveStrings.s = "")
    If SaveStrings = "" 
      scanner\SaveString = scanner\SaveString + scanner\token\token
      scanner\token\token = ""
    Else
      scanner\SaveString = scanner\SaveString + SaveStrings
    EndIf
  EndProcedure
  
  Procedure DOLABEL(lmode.i, generate.i)
    Select lmode
      Case #DOESNEW
        scanner\labelnumber + 1
        scanner\token\token = scanner\LabelName + Trim(Str(scanner\labelnumber))
        Select  generate
          Case #DOESOUT
            scanner\OutString = scanner\OutString + scanner\token\token
          Case #DOESSAVE
            scanner\SaveString = scanner\SaveString + scanner\token\token
        EndSelect
      Case #DOESPREVIOUS
        Select  generate
          Case #DOESOUT
            scanner\OutString = scanner\OutString + scanner\token\token
          Case #DOESSAVE
            scanner\SaveString = scanner\SaveString + scanner\token\token
        EndSelect
    EndSelect
  EndProcedure
  
  Procedure.i STACKS(fromwhat.i, stringvals.s = "", type.i=#none, whichs.i = 0)
    Protected which.i
;     Protected stringval.s
;     stringval = stringvals
    which = whichs
    scanner\stackpointer(which) + 1
    If scanner\stackpointer(which) < #MAXINSTACK 
      If fromwhat = #FROMSAVE 
        scanner\stack(which, scanner\stackpointer(which))\token = scanner\SaveString
        scanner\stack(which, scanner\stackpointer(which))\tokentype = type
        scanner\SaveString = ""
      Else
        If fromwhat = #FROMTOKEN 
          scanner\stack(which, scanner\stackpointer(which))\token = scanner\token\token
          If type = #none And scanner\token\tokentype <> #none
            scanner\stack(which, scanner\stackpointer(which))\tokentype = scanner\token\tokentype
          Else
            scanner\stack(which, scanner\stackpointer(which))\tokentype = type
          EndIf
          scanner\token\token = ""
        Else
          scanner\stack(which, scanner\stackpointer(which))\token = stringvals
          scanner\stack(which, scanner\stackpointer(which))\tokentype = type
        EndIf
      EndIf
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  EndProcedure
  
  Procedure POPSTACK(whichs.i = 0)
    Protected which.i
    which = whichs
    If scanner\stackpointer(which) > 0 
      scanner\token\token = scanner\stack(which, scanner\stackpointer(which))\token
      scanner\token\tokentype = scanner\stack(which, scanner\stackpointer(which))\tokentype
      scanner\stack(which, scanner\stackpointer(which))\token = ""
      scanner\stack(which, scanner\stackpointer(which))\tokentype = #none
      scanner\stackpointer(which) - 1
    EndIf
  EndProcedure
  
  Procedure PEEKSTACK(element.i, whichs.i=0)
    Protected which.i
    which = whichs
    If element > 0 
      scanner\token\token = scanner\stack(which, element)\token
      scanner\token\tokentype = scanner\stack(which, element)\tokentype
    EndIf
  EndProcedure
  
  Procedure PEEPSTACK(whichs.i=0)
    Protected which.i
    which = whichs
    If scanner\stackpointer(which) > 0 
      scanner\token\token = scanner\stack(which, scanner\stackpointer(which))\token
      scanner\token\tokentype = scanner\stack(which, scanner\stackpointer(which))\tokentype
    EndIf
  EndProcedure
  
  Procedure EMIT(EmitString.s, whichs.i=0)
    Protected which.i
    which = whichs
    If which = #FROMOUT 
      scanner\OutString = scanner\OutString + scanner\token\token
    Else
      If which = #FROMSAVE 
        scanner\OutString = scanner\OutString + scanner\SaveString
      Else
        If which = #FROMSTRING 
          scanner\OutString = scanner\OutString + Chr(34) + scanner\token\token + Chr(34)
        Else
          scanner\OutString = scanner\OutString + EmitString
        EndIf
      EndIf
    EndIf
  EndProcedure
  
  Procedure FLUSH()
    WriteStringN(scanner\fileoutputchannel, scanner\OutString)
    scanner\OutString = ""
  EndProcedure
EndModule
Last edited by startup on Sun Oct 18, 2015 2:11 am, edited 1 time in total.
Top
startup
Enthusiast
Enthusiast
Posts: 105
Joined: Wed Feb 25, 2015 5:55 pm

Re: meta pi compiler compiler

Post by startup »

a simple demo:
from the internet the original, but a little modified:

Code: Select all

 For example, in BNF, the classic expression grammar is:

  <expr> ::= <term> "+" <expr>
          |  <term>
 
  <term> ::= <factor> "*" <term>
          |  <factor>
 
  <factor> ::= "(" <expr> ")"
            |  <const>
 
  <const> ::= integer

a little pulled apart, attributed and after compilation runable

Code: Select all

@@
global result.i
@@

expr(*res.integer)   := @@ protected tmp.i=0 @@ 
                        term(*res) { "+" expr(@tmp) @@ *res\i + tmp @@ } ;
term(*res.integer)   := @@ protected tmp.i=0 @@
                        factor(*res) 
                        { "*" term(@tmp) @@ *res\i * tmp @@ } ;
factor(*res.integer) := "(" expr(*res) ")"  
                        |  {"-" @@ protected tmps.i=1 @@ } .INT:i_var 
                        @@ if tmps = 1
                             i_var * -1
                           endif
                           *res\i=i_var @@
                        | .ID:yy {"=" .INT:zz }
                        ;

#END

@@
scanner\line_s = "2 * -3 + 4"
expr(@res)
@@
Last edited by startup on Sun Oct 18, 2015 2:09 am, edited 2 times in total.
Top
User avatar
Demivec
Addict
Addict
Posts: 4270
Joined: Mon Jul 25, 2005 3:51 pm
Location: Utah, USA

Re: meta pi compiler compiler

Post by Demivec »

Thanks for posting this.

Can you label the examples so it is clearer how the parts go together. Things such as filenames or that one file is to be used as input to another file. If there are groups of files that are used together can you also label them as such.

I find the code you presented useful but I am having some trouble organizing it.
Top
Post Reply

Return to “Applications - Feedback and Discussion”