Quake C

Blitz3D Forums/Blitz3D Userlibs/Quake C

Yasha (Posted 2009) [#1]

DO NOT USE THIS CODE!!! IT DOES NOT WORK!!! It's here for historical reasons only. --- EDIT4: I think I'll fork the projects actually - see if I can finish Noodle completely and then come back to this and build it to more closely imitate a QuakeLike, just for fun. EDIT3: GC is functional (it's a tracing GC based on HotSpot, so cyclic references ought not to be a problem), but there is no tenured storage yet (so very limited). EDIT2: New version is not quite ready for release, but you can download the incomplete version and keep an eye on the progress here. It'll be out as soon as the GC (yes, a GC) is done usable. Now includes object-oriented features - methods, inheritance and polymorphism! EDIT: This doesn't really work as-is. Rather than fix it (it's borderline impossible to fix this coding disaster), I'm rewriting it from scratch, which will take a little longer but allow a few extra features (OK, OK, custom types and dynamic arrays are going in) as well as getting rid of that pesky GPL. The code remains here if you want to examine it anyway, but be warned that there are so many typos and holes that you could throw a brick through this and not see a difference. --- Quake C is a lightweight scripting language with C-like syntax, developed by ID to write scripts for the original Quake engine. I thought it might be fun to use it as a scripting solution for Blitz projects - here is the result so far. Please note that this is not extensively tested - I haven't tested arrays at all - and not necessarily complete. I am not yet sure about its speed compared to other options (in my only test, it was faster than GameScript, but that was most likely non-representative). First - language specification: http://www.gamers.org/dEngine/quake/spec/quake-spec34/qc-menu.htm (only the first page is really relevant due to the changes) This implementation has a few differences, however. Firstly, most obviously, Progs.dat is no longer relevant, so unless you especially want to compile to a file named that, the compiler simply outputs separate compiled scripts named scriptname.qcx (get used to recognising GameScript ideas). Source therefore needs to have a "main()" function and won't work without it. Secondly, "states" or "frame functions" are also absent, again being only relevant to the Quake engine, and the same goes for $-macros and the "field" data type. Thirdly, I have added simple preprocessor directives (#include, #define, #ifdef, #endif - #define is a simple copy and paste though, not a proper macro) and the ability to define simple arrays (after the fashion of Blitz arrays, they can be local and must be of constant size. You can use #defined constants for this, but not QuakeC constants). Since the interpreter now uses a stack instead of hundreds of global variables, it is now possible to call functions as parameters to other functions (composition) or operators (both impossible in the original). I have not added custom types and do not currently intend to do so. Special mention needs to go to built-in functions (even though I actually haven't changed that) because they do still need to be prototyped in the script's source (the idea being that you make your own list of builtins and hardcode complex types as your project requires). And no, the absence of integers is not an error, it is intentional. Add them if you want, but it adds complexity. The syntax is similar enough to C that a C IDE will provide context highlighting and indentation services, but not so similar that the code will compile. I don't ask for more than that from IDEs so I don't know if other features would work. Finally, before we get to the code, the reason this isn't going straight into the code archives to be ignored in the right place is because the Quake code was released under the GPL - keep reading! - and therefore the compiler, which is almost entirely straight copied from the original source, falls under the same licence. The interpreter I made without reference to the Quake source - it's obviously similar, because it reads the output of the compiler, but it is my own work (working in a significantly different way from the original) and therefore can be released to the public domain. In the unlikely event anyone uses this, you can use the interpreter in your projects, but do not put the compiler in your main source or the GPL will infect that as well. Distribute the compiler as a separate exe (and source, of course) and you will be safe from the GPL. The alert reader will notice some conventions (packing loaded scripts into "threads", compiling to extension+"x", etc.) are borrowed from GameScript. Conventions and stylistic ideas are all I borrowed - I have no idea how GameScript works because I don't have the patience to read through it (that's why I made my own alternative), so any non-stylistic similarities are coincidental, or at least unintentional. 1. The compiler ;Blitz3D QuakeC Compiler ;======================= ;=============================================================================; ; Copyright (C) 1996-1997 Id Software, Inc. ; ; ; ; This program is free software; you can redistribute it and/or modify ; ; it under the terms of the GNU General Public License as published by ; ; the Free Software Foundation; either version 2 of the License, or ; ; (at your option) any later version. ; ; ; ; This program is distributed in the hope that it will be useful, ; ; but WITHOUT ANY WARRANTY; without even the implied warranty of ; ; MERCHANTABILITY Or FITNESS For A PARTICULAR PURPOSE. See the ; ; GNU General Public License For more details. ; ; ; ; You should have received a copy of the GNU General Public License ; ; along with this program; if not, write to the Free Software ; ; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ; ;=============================================================================; ;Main ;---- ;Setup definitions and declare globals Include "qcch.bb" ;Header ;cmd$=CommandLine() ;...if running as .exe cmd$="test.c --asm" ;...if running from source ;Get compilation parameters CheckParm(cmd) ;Load and preprocess files PR_Preprocess() ;Compile: Print "Compiling "+pr_filename+"..." ; - Parse files line by line PR_CompileFile() ; - Check for errors PR_ErrorCheck() ;Write byte code to output If Not pr_comp_err Then WriteData() ;Dump additional data If pr_dumpasm Then DumpAsm() ;Deal with any other files (eg. media) ; - Print "Done!":Print "" Print "Press any key to exit..." WaitKey End Function PR_Preprocess() Local src.sourcefile=New sourcefile Local m.macro,n.macro,pos,ptr src\h=ReadFile(pr_filename) sourcebank=CreateBank(4) Repeat srcline$=ReadLine(src\h) If Left(srcline,1)="#" com=Instr(srcline,"/*") If com>0 remain$=Right(srcline,Len(srcline)-(com-1)) WriteLine tempsrc,remain ;Rescue comments with /* as otherwise there will be parse errors later srcline=Trim(Left(srcline,com-1)) EndIf com=Instr(srcline,"//") If com>0 Then srcline=Trim(Left(srcline,com-1)) If Left(srcline,8)="#define " And skip=0 ;Add a macro m=New macro srcline=Trim(Right(srcline,Len(srcline)-8)) sep=Instr(srcline," ") m\tok=Trim(Left(srcline,sep)) m\def=Trim(Right(srcline,Len(srcline)-sep)) For n=Each macro If n<>m And m\tok=n\tok Then PR_ParseError("Token "+tok+" is already defined") Next ElseIf Left(srcline,7)="#undef " And skip=0 ;Remove a macro srcline=Trim(Right(srcline,Len(srcline)-7)) For m=Each macro If m\tok=srcline Then Delete m Next ElseIf Left(srcline,7)="#ifdef " ;Conditional compilation srcline=Trim(Right(srcline,Len(srcline)-7)) skip=skip+1 For m=Each macro If m\tok=srcline Then skip=skip-1 Next ElseIf Left(srcline,6)="#endif" ;End of conditional compilation block If skip>0 Then skip=skip-1 ElseIf Left(srcline,9)="#include " And skip=0 ;Include files srcline=Trim(Right(srcline,Len(srcline)-8)) If Left(srcline,1)=Chr(34) And Right(srcline,1)=Chr(34) Then srcline=Mid(srcline,2,Len(srcline)-2) ;Cut off quote marks src=New sourcefile src\h=ReadFile(srcline) EndIf Else If skip=0 For m=Each macro srcline=Replace(srcline,m\tok,m\def) Next ResizeBank sourcebank,BankSize(sourcebank)+Len(srcline)+2 For ptr=0 To Len(srcline)-1 PokeByte sourcebank,pos+ptr,Asc(Mid(srcline,ptr+1,1)) Next PokeShort sourcebank,pos+ptr,$A0D ;CR+LF - end of line pos=pos+ptr+2 EndIf EndIf If Eof(src\h) CloseFile src\h Delete src src=Last sourcefile If src=Null Then Exit EndIf Forever If pr_dumpsrc debugout=WriteFile(pr_tempsrc) WriteBytes(sourcebank,debugout,0,BankSize(sourcebank)) CloseFile debugout EndIf PokeInt(sourcebank,pos,$FFFFFFFF) ;Mark EOF End Function Function PR_CompileFile() ;compiles the 0 terminated text, adding defintions to the pr structure pr_source_line=0 pr_file_p=0 PR_Newline PR_Lex While pr_token_type<>tt_EOF pr_scope=Null ;Outside all functions PR_ParseDefs Wend For statement.statement_t=Each statement_t If Left(opcode[statement\op]\opname,5)="STORE" statement\c=statement\b ;\c is the result argument. Store holds it in \b so the optimisation works statement\b=NULLVAR EndIf Next End Function Function PR_Newline() ;Call at start of file and when *pr_file_p == '\n' Local m If PeekShort(sourcebank,pr_file_p)=$A0D ;CR+LF pr_file_p=pr_file_p+1 m=True Else m=False EndIf pr_source_line=pr_source_line+1 If m Then pr_file_p=pr_file_p-1 End Function Function PR_Lex() ;Reads the next token into pr_token and classifies its type Local c pr_token="" PR_LexWhitespace c=PeekByte(sourcebank,pr_file_p) If c=src_EOF pr_token_type=tt_EOF Return EndIf If c=34 ;Double quote - handle quoted strings as one unit PR_LexString Return EndIf If c=39 ;Single quote - handle quoted vectors as one unit PR_LexVector Return EndIf If (c>=48 And c<=57) Or (c=45 And (PeekByte(sourcebank,pr_file_p+1)>=48) And (PeekByte(sourcebank,pr_file_p+1)<=57)) pr_token_type=tt_IMMEDIATE pr_immediate_type=ev_FLOAT pr_immediate\fl=PR_LexNumber() Return EndIf If (c>=97 And c<=122) Or (c>=65 And c<=90) Or c=95 ;Valid character to begin a name PR_LexName Return EndIf PR_LexPunctuation End Function Function PR_LexName() ;Parses an identifier Local c=PeekByte(sourcebank,pr_file_p) pr_token="" While ((c>=97 And c<=122) Or (c>=65 And c<=90) Or c=95 Or (c>=48 And c<=57)); Or c=46 ;95=_ 46=. Whichever you prefer as field separator pr_token=pr_token+Chr(c) pr_file_p=pr_file_p+1 c=PeekByte(sourcebank,pr_file_p) Wend pr_token_type=tt_NAME End Function Function PR_LexPunctuation() pr_token_type=tt_PUNCT Local i,ptr,pp$ For i=0 To MAX_SYMBOLS pp="" For ptr=0 To Len(pr_punctuation[i])-1 pp=pp+Chr(PeekByte(sourcebank,pr_file_p+ptr)) Next If pp=pr_punctuation[i] pr_token=pp pr_file_p=pr_file_p+Len(pp) Return EndIf Next PR_ParseError("Unknown punctuation") End Function Function PR_LexString() ;Parses a quoted string Local c pr_file_p=pr_file_p+1 pr_token="" Repeat c=PeekByte(sourcebank,pr_file_p) pr_file_p=pr_file_p+1 If c=0 Then PR_ParseError("EOF inside quote") If c=13 Then PR_ParseError("newline inside quote") If c=92 ;backslash - escape character c=PeekByte(sourcebank,pr_file_p) pr_file_p=pr_file_p+1 If c=0 Then PR_ParseError("EOF inside quote") Select c ;Escape characters Case 110 ;Newline \n c=13 Case 34 ;Double quote \" c=34 ;Add others here if required Default PR_ParseError("Unknown escape character") End Select ElseIf c=34 ;double quote - end string pr_token=pr_token+Chr(0) pr_token_type=tt_IMMEDIATE pr_immediate_type=ev_STRING pr_immediate\st=pr_token Return EndIf pr_token=pr_token+Chr(c) Forever End Function Function PR_LexVector() ;Parses a single quoted vector Local i pr_file_p=pr_file_p+1 pr_token_type=tt_IMMEDIATE pr_immediate_type=ev_VECTOR For i=0 To 2 pr_immediate\vec[i]=PR_LexNumber() PR_LexWhitespace Next If PeekByte(sourcebank,pr_file_p)<>39 Then PR_ParseError("Bad vector") pr_file_p=pr_file_p+1 End Function Function PR_LexWhitespace() Local c=PeekByte(sourcebank,pr_file_p) ;Current character of source Local continue=True ;Use this instead of C's "continue" command - Goto would be better in a bigger function though Repeat continue=True While (c<=32) ;skip whitespace If (c=13) Then PR_NewLine If (c=0) Then Return ; end of file pr_file_p=pr_file_p+1 c=PeekByte(sourcebank,pr_file_p) Wend If c=47 And PeekByte(sourcebank,pr_file_p+1)=47 ;skip // comments While c<>0 And (c<>13) pr_file_p=pr_file_p+1 c=PeekByte(sourcebank,pr_file_p) Wend PR_NewLine pr_file_p=pr_file_p+1 c=PeekByte(sourcebank,pr_file_p) continue=False EndIf If continue If c=47 And PeekByte(sourcebank,pr_file_p+1)=42 ;skip /* */ comments Repeat pr_file_p=pr_file_p+1 c=PeekByte(sourcebank,pr_file_p) If c=13 Then PR_NewLine If PeekByte(sourcebank,pr_file_p+1)=0 Then Return ;EOF Until PeekByte(sourcebank,pr_file_p-1)=42 And c=47 pr_file_p=pr_file_p+1 c=PeekByte(sourcebank,pr_file_p) continue=False EndIf EndIf If continue Then Exit Forever End Function Function PR_LexNumber#() Local c=PeekByte(sourcebank,pr_file_p) pr_token="" While ((c>=48 And c<=57) Or c=45 Or c=46) ;No 45 in orig? pr_token=pr_token+Chr(c) pr_file_p=pr_file_p+1 c=PeekByte(sourcebank,pr_file_p) Wend Return Float(pr_token) End Function Function PR_Check(chk$) ;Returns True and gets the next token if the current token equals string If chk=pr_token ;Returns False and does nothing otherwise PR_Lex Return True Else Return False EndIf End Function Function PR_Expect(chk$) ;Issues an error if the current token isn't equal to string If chk<>pr_token ;Gets the next tokem PR_ParseError("expected "+pr_token+", found "+chk) EndIf PR_Lex End Function Function PR_ParseDefs() ;Called at the outer layer and when a local statement is hit Local deftype,ID,name$,v.vdef,f.fdef deftype=PR_ParseType() If pr_scope<>Null And deftype=ev_FUNCTION Then PR_ParseError("Functions must be global") Repeat name=PR_ParseName() ID=PR_GetDef(deftype,name,pr_scope,True) v=GetVar(ID) If PR_Check("=") If deftype<>ev_FUNCTION If v\init Then PR_ParseError(name+" redeclared") EndIf If deftype=ev_FUNCTION f=GetFunc(ID) pr_scope=f PR_ParseImmediateStatements(f) pr_scope=Null f\defined=True ElseIf pr_immediate_type<>deftype PR_ParseError("Wrong immediate type for "+name) Else v\init=True If deftype=ev_STRING Then v\s=pr_immediate\st If deftype=ev_FLOAT Then v\f=pr_immediate\fl If deftype=ev_VECTOR v\vx=New vdef:v\vx\vtype=ev_FLOAT:v\vx\name=name+"_x":v\vx\scope=pr_scope:v\vx\init=True:v\vx\f=pr_immediate\vec[0] v\vy=New vdef:v\vy\vtype=ev_FLOAT:v\vy\name=name+"_y":v\vy\scope=pr_scope:v\vy\init=True:v\vy\f=pr_immediate\vec[1] v\vz=New vdef:v\vz\vtype=ev_FLOAT:v\vz\name=name+"_z":v\vz\scope=pr_scope:v\vz\init=True:v\vz\f=pr_immediate\vec[2] EndIf ;Add more types as required PR_Lex EndIf ElseIf PR_Check("[") If deftype=ev_FUNCTION Then PR_ParseError("Frame functions are not supported") If pr_token_type<>tt_IMMEDIATE Then PR_ParseError("Arrays must be constant") If Asc(Left(pr_token,1))<48 Or Asc(Left(pr_token,1))>57 Or pr_immediate\fl<>Int(pr_immediate\fl) Then PR_ParseError("Array size must be positive integer") v\array=True v\e=pr_immediate\fl ;We're storing an integer, regardless of the variable's type - the number of elements PR_Lex PR_Expect("]") For i=1 To v\e ;Create the array elements PR_GetDef(v\vtype,v\name+"_"+(i-1),pr_scope,True) Next EndIf Until Not PR_Check(",") PR_Expect(";") End Function Function PR_ParseType%() ;Parses a definition's type, including function types Local deftype,func.fdef Select Lower(pr_token) ;Add any other types here Case "float" deftype=ev_FLOAT Case "string" deftype=ev_STRING Case "vector" deftype=ev_VECTOR Case "void" deftype=ev_VOID Case "entity" deftype=ev_ENTITY Default PR_ParseError(pr_token+" is not a recognised type") End Select PR_Lex If Not PR_Check("(") Then Return deftype ;Function type pr_fdef_type=deftype pr_fdef_parms=0 If Not PR_Check(")") If PR_Check ("...") pr_fdef_parms=-1 ;variable number of parameters Else Repeat pr_fdef_ptype[pr_fdef_parms]=PR_ParseType() ;Store this stuff in temporary space until the function def actually exists pr_fdef_pname[pr_fdef_parms]=PR_ParseName() pr_fdef_parms=pr_fdef_parms+1 Until Not PR_Check(",") EndIf PR_Expect(")") EndIf Return ev_FUNCTION End Function Function PR_ParseName$() ;Checks to see if the current token is a valid name Local ident$ If pr_token_type<>tt_NAME Then PR_ParseError("Not a name") If Len(pr_token)>MAX_NAME Then PR_ParseError("Name too long") ident=pr_token PR_Lex Return ident End Function Function PR_GetDef(deftype,name$,scope.fdef,allocate) ;If type is 0, it will match any type Local i,v.vdef,f.fdef ;If allocate is true, a new def will be allocated if it can't be found ;See if the name is already in use For f.fdef=Each fdef ;Check functions If name=f\name If deftype<>0 And deftype<>ev_FUNCTION Then PR_ParseError("Type mismatch on redeclaration of "+name) Return f\ID EndIf Next For v.vdef=Each vdef ;Check variables If name=v\name If v\scope=Null Or scope=v\scope If deftype<>0 And (deftype<>v\vtype) Then PR_ParseError("Type mismatch on redeclaration of "+name) Return v\ID EndIf EndIf Next If Not allocate Then Return -1 If deftype<>ev_FUNCTION v.vdef=New vdef v\name=name v\scope=scope v\vtype=deftype v\ID=vcounter vcounter=vcounter+1 If deftype=ev_VECTOR ;Create the vector fields v\vx=GetVar(PR_GetDef(ev_FLOAT,v\name+"_x",scope,True)) v\vy=GetVar(PR_GetDef(ev_FLOAT,v\name+"_y",scope,True)) v\vz=GetVar(PR_GetDef(ev_FLOAT,v\name+"_z",scope,True)) EndIf ;Do the same for any other inbuilt complex types Return v\ID Else f=New fdef f\name=name f\ID=fcounter fcounter=fcounter+1 f\rtype=pr_fdef_type f\num_parms=pr_fdef_parms For i=0 To pr_fdef_parms-1 f\parm_type[i]=pr_fdef_ptype[i] f\parm_name[i]=pr_fdef_pname[i] Next Return f\ID EndIf End Function Function PR_ParseImmediateStatements(f.fdef) ;Parse a function body If PR_Check ("#") If pr_token_type<>tt_IMMEDIATE Or pr_immediate_type<>ev_FLOAT Or pr_immediate\fl<>Int(pr_immediate\fl) Then PR_ParseError("Bad builtin immediate") f\builtin=Int(pr_immediate\fl) PR_Lex Return EndIf f\builtin=0 f\code=numstatements ;Define the parameters For i=0 To f\num_parms-1 f\parm[i]=PR_GetDef(f\parm_type[i],f\parm_name[i],f,True) Next ;Parse regular statements PR_Expect("{") While Not PR_Check("}") PR_ParseStatement Wend ;Emit an end-of-statements opcode PR_Statement(OP_DONE,NULLVAR,NULLVAR) End Function Function PR_ParseStatement() Local e,patch1.statement_t,patch2.statement_t If PR_Check("{") Repeat PR_ParseStatement Until PR_Check("}") Return EndIf If PR_Check("return") If PR_Check(";") PR_Statement(OP_RETURN,NULLVAR,NULLVAR) Return EndIf e=PR_Expression(TOP_PRIORITY) PR_Expect(";") PR_Statement(OP_RETURN,e,NULLVAR) Return EndIf If PR_Check("while") PR_Expect("(") patch2=Last statement_t e=PR_Expression(TOP_PRIORITY) patch2=After patch2 PR_Expect(")") PR_Statement(OP_IFNOT,e,0) patch1=Last statement_t PR_ParseStatement PR_Statement(OP_GOTO,patch2\ID-1,NULLVAR) patch1\b=numstatements-1 ;Set jump points one earlier as every cycle the instruction pointer is incremented Return EndIf If PR_Check("do") patch1=Last statement_t PR_ParseStatement patch1=After patch1 PR_Expect("while") PR_Expect("(") e=PR_Expression(TOP_PRIORITY) PR_Expect(")") PR_Expect(";") PR_Statement(OP_IF,e,patch1\ID-1) Return EndIf If PR_Check("local") PR_ParseDefs Return EndIf If PR_Check("if") PR_Expect("(") e=PR_Expression(TOP_PRIORITY) PR_Expect(")") PR_Statement(OP_IFNOT,e,0) patch1=Last statement_t PR_ParseStatement If PR_Check("else") PR_Statement(OP_GOTO,0,NULLVAR) patch2=Last statement_t patch1\b=numstatements-1 PR_ParseStatement patch2\a=numstatements-1 Else patch1\b=numstatements-1 EndIf Return EndIf PR_Expression(TOP_PRIORITY,True) PR_Expect(";") End Function Function PR_Statement.vdef(op,a,b) ;Emits a primitive statement, returning the var it places its value in Local statement.statement_t,s2.statement_t,var_c.vdef statement=New statement_t statement\op=op statement\a=a statement\b=b statement\ID=numstatements numstatements=numstatements+1 If opcode[op]\type_c=ev_VOID Or opcode[op]\ra ;If, goto, assignment don't need result space var_c=Null statement\c=NULLVAR If statement<>First statement_t If Left(opcode[op]\opname,5)="STORE" ;Take advantage of third parameter to store result in one go s2=Before statement ; and not waste time with the stack If statement\a=s2\c s2\c=statement\b Delete statement numstatements=numstatements-1 EndIf EndIf EndIf Else ;Use the stack, Luke statement\c=STACKID var_c=First vdef;GetVar(STACKID) var_c\vtype=opcode[op]\type_c EndIf If opcode[op]\ra Return GetVar(a) Else Return First vdef;var_c EndIf End Function Function PR_Expression(priority,popstack=False) Local e,e2,op,oldop,v1.vdef,v2.vdef,s.statement_t If priority=0 Then Return PR_Term() e=PR_Expression(priority-1) Repeat If priority=1 And PR_Check("(") Then Return PR_ParseFunctionCall(GetFunc(e)) If priority=1 And PR_Check("[") Then Return PR_ParseArrayElement(GetVar(e)) For op=0 To NUM_OPCODES-1 If opcode[op]\priority=priority If PR_Check(opcode[op]\name) If opcode[op]\ra ;Field stuff happens here (change indirect to address). But not today, as there are no complex types yet e2=PR_Expression(priority) Else e2=PR_Expression(priority-1) EndIf ;Type check v1=GetVar(e):type_a=v1\vtype v2=GetVar(e2):type_b=v2\vtype If Left(opcode[op]\name,1)="." ;field access gets type from field ;Add when complex types are actually implemented Else type_c=ev_VOID EndIf oldop=op While type_a<>opcode[op]\type_a Or type_b<>opcode[op]\type_b Or (type_c<>ev_void And type_c<>opcode[op]\type_c) op=op+1 If opcode[op]=Null Then PR_ParseError("Type mismatch for "+opcode[oldop]\name) If opcode[op]\name<>opcode[oldop]\name Then PR_ParseError("Type mismatch for "+opcode[oldop]\name) Wend If type_a=ev_POINTER And type_b<>v1\vtype Then PR_ParseError("Type mismatch for "+opcode[op]\name) ;Not really relevant yet If opcode[op]\ra v1=PR_Statement(op,e2,e) Else v1=PR_Statement(op,e,e2) EndIf e=v1\ID Exit EndIf EndIf Next If opcode[op]=Null Then Exit Forever If popstack ;If the line ends without storing the result, discard it rather than confuse the stack s=Last statement_t If s\c=STACKID Then s\c=NULLVAR EndIf Return e End Function Function PR_ParseFunctionCall(func.fdef) Local e.vdef,i,args,argptr[MAX_PARMS-1] ;Copy the arguments to the global parameter variables If Not PR_Check(")") Repeat If func\num_parms<>-1 And arg>=func\num_parms Then PR_ParseError("Too many parameters") e=GetVar(PR_Expression(TOP_PRIORITY)) If func\num_parms<>-1 And e\vtype<>func\parm_type[arg] Then PR_ParseError("Type mismatch on parameter "+arg) argptr[arg]=e\ID:arg=arg+1 Until Not PR_Check(",") For i=arg-1 To 0 Step -1 PR_Statement(OP_STORE_V,argptr[i],STACKID) Next If func\num_parms<>-1 And func\num_parms<>arg Then PR_ParseError("Too few parameters") PR_Expect(")") EndIf If arg>=MAX_PARMS Then PR_ParseError("More than "+MAX_PARMS+" parameters") PR_Statement(OP_CALL,func\ID,arg) def_ret\vtype=func\rtype Return def_ret\ID End Function Function PR_ParseArrayElement(v.vdef) e=PR_Expression(TOP_PRIORITY) PR_Expect("]") PR_Statement(OP_ARRAY,v\ID,e) Return STACKID End Function Function PR_Term() Local e.vdef,e2.vdef,f If PR_Check("!") e=GetVar(PR_Expression(NOT_PRIORITY)) If e\vtype=ev_FLOAT ;Add info for other types here e2=PR_Statement(OP_NOT_F,e\ID,0) ElseIf e\vtype=ev_STRING e2=PR_Statement(OP_NOT_S,e\ID,0) ElseIf e\vtype=ev_VECTOR e2=PR_Statement(OP_NOT_V,e\ID,0) ElseIf e\vtype=ev_ENTITY e2=PR_Statement(OP_NOT_ENT,e\ID,0) ElseIf e\vtype=ev_FUNCTION e2=PR_Statement(OP_NOT_FUNC,e\ID,0) Else PR_ParseError("Type mismatch for !") EndIf Return e2\ID EndIf If PR_Check("(") f=PR_Expression(TOP_PRIORITY) PR_Expect(")") Return f EndIf Return PR_ParseValue() End Function Function PR_ParseValue() ;Get a reference for the current token Local name$,d,v.vdef ;If the token is an immediate, allocate a constant for it If pr_token_type=tt_IMMEDIATE Then Return PR_ParseImmediate() ;If not, look through the defs name=PR_ParseName() d=PR_GetDef(0,name,pr_scope,False) If d=-1 Then PR_ParseError("Unknown value "+name) Return d End Function Function PR_ParseImmediate() ;Looks for a preexisting constant Local con.vdef,continue=True ;Check for a constant with the same value For con=Each vdef If con\init And con\vtype=pr_immediate_type If pr_immediate_type=ev_STRING If con\s=pr_immediate\st PR_Lex Return con\ID EndIf ElseIf pr_immediate_type=ev_FLOAT If con\f=pr_immediate\fl PR_Lex Return con\ID EndIf ElseIf pr_immediate_type=ev_VECTOR If con\vx\f=pr_immediate\vec[0] And con\vy\f=pr_immediate\vec[1] And con\vz\f=pr_immediate\vec[2] PR_Lex Return con\ID EndIf ;Add any other immediate types here Else PR_ParseError("Unexpected immediate type") EndIf EndIf Next ;Allocate a new one - don't use PR_GetDef for this con=New vdef con\vtype=pr_immediate_type con\name="IMMEDIATE" con\scope=Null con\init=True con\ID=vcounter vcounter=vcounter+1 ;Copy the immediate to the global area If pr_immediate_type=ev_STRING Then con\s=pr_immediate\st If pr_immediate_type=ev_FLOAT Then con\f=pr_immediate\fl If pr_immediate_type=ev_VECTOR con\vx=New vdef:con\vx\vtype=ev_FLOAT:con\vx\name="IMMEDIATE_X":con\vx\scope=Null:con\vx\init=True:con\vx\f=pr_immediate\vec[0] con\vx\ID=vcounter:vcounter=vcounter+1 con\vy=New vdef:con\vy\vtype=ev_FLOAT:con\vy\name="IMMEDIATE_Y":con\vy\scope=Null:con\vy\init=True:con\vy\f=pr_immediate\vec[1] con\vy\ID=vcounter:vcounter=vcounter+1 con\vz=New vdef:con\vz\vtype=ev_FLOAT:con\vz\name="IMMEDIATE_Z":con\vz\scope=Null:con\vz\init=True:con\vz\f=pr_immediate\vec[2] con\vz\ID=vcounter:vcounter=vcounter+1 EndIf ;Again, add more types as required PR_Lex Return con\ID End Function Function PR_ErrorCheck() ;Check all prototypes were defined, and that main() exists Local e,f.fdef,undefined$[MAX_ERRORS] Local mainexists,maindefined For f=Each fdef If f\name="main" mainexists=True If f\defined=False Then mainexists=-1 EndIf If f\defined=False If errors<MAX_ERRORS undefined[errors]=f\name pr_comp_err=pr_comp_err+1 Else undefined[MAX_ERRORS]="...Error limit exceeded!" EndIf EndIf Next If pr_comp_err Print "" Print "Prototyped functions were not defined:" For e=0 To pr_comp_err-1 Print undefined[e] Next Print "" EndIf If mainexists=0 Print "Function main() was not found!" Print "":pr_comp_err=pr_comp_err+1 ElseIf mainexists=-1 Print "Function main() was not defined!" Print "":pr_comp_err=pr_comp_err+1 EndIf End Function Function PR_ParseError(err$) Print "" Print "ERROR in line "+pr_source_line+": "+err Print "Compilation halted, press any key to exit." WaitKey End End Function Function CheckParm(cmd$) ;Get parameters off the command line pr_filename=Left(cmd,Instr(cmd,FILE_EXTENSION)-1) If Instr(cmd,"--asm") Then pr_dumpasm=True:pr_asmfile=pr_filename+"_asm.txt" If Instr(cmd,"--src") Then pr_dumpsrc=True:pr_tempsrc=pr_filename+"_src"+FILE_EXTENSION pr_fileout=pr_filename+".qcx" pr_filename=pr_filename+FILE_EXTENSION ;Add other parameters as required End Function Function GetVar.vdef(ID) Local var.vdef If ID=NULLVAR Then Return Null For var=Each vdef If var\ID=ID Then Return var Next End Function Function GetFunc.fdef(ID) Local func.fdef If ID=-1 Then Return Null For func=Each fdef If func\ID=ID Then Return func Next End Function Function WriteData() ;Output a compiled script Local v.vdef,f.fdef,s.statement_t Local output=WriteFile(pr_fileout) ;Header WriteInt output,vcounter WriteInt output,fcounter WriteInt output,numstatements If vcounter>MAX_VARS Then Print "Warning: Exceeded variable limit!":Print "" If vcounter>MAX_FUNCS Then Print "Warning: Exceeded function limit!":Print "" If vcounter>MAX_OPS Then Print "Warning: Exceeded statement limit!":Print "" ;Variables For v=Each vdef WriteString output,v\name If v\scope=Null WriteInt output,-1 Else WriteInt output,v\scope\ID EndIf WriteByte output,v\vtype WriteByte output,v\array If v\vtype=ev_FLOAT Then WriteFloat output,v\f If v\vtype=ev_STRING Then WriteString output,v\s If v\vtype=ev_ENTITY Or v\array=True Then WriteInt output,v\e ;Not much point storing object handles... but you can put other ints here If v\vtype=ev_VECTOR WriteInt output,v\vx\ID WriteInt output,v\vy\ID WriteInt output,v\vz\ID EndIf ;And any other types Next ;Functions For f=Each fdef If f\name="main" Then pr_main=f\code WriteString output,f\name WriteByte output,f\rtype WriteInt output,f\code WriteShort output,f\builtin For v=Each vdef If v\scope=f If f\fvar=0 Then f\fvar=v\ID f\lvar=v\ID EndIf Next WriteInt output,f\fvar WriteInt output,f\lvar WriteByte output,f\num_parms For i=0 To f\num_parms-1 WriteString output,f\parm_name[i] WriteByte output,f\parm_type[i] WriteInt output,f\parm[i] Next Next WriteInt output,pr_main ;Start of main() - the entry point ;Instructions For s=Each statement_t WriteByte output,s\op WriteInt output,s\a WriteInt output,s\b WriteInt output,s\c Next CloseFile output End Function Function DumpAsm() ;Write out the compiled script as legible statements Local v.vdef,f.fdef,s.statement_t Local output=WriteFile(pr_asmfile),pr_main=-1 ;Header WriteLine output,"" WriteLine output,"Total variables: "+vcounter WriteLine output,"Total functions: "+fcounter WriteLine output,"Total statements: "+numstatements WriteLine output,"==================================================" WriteLine output,"" WriteLine output,"" ;Variables WriteLine output,"Variables:" WriteLine output,"" For v=Each vdef WriteLine output,"ID: "+v\ID WriteLine output,"Name: "+v\name If v\scope=Null WriteLine output,"Scope: Global" Else WriteLine output,"Scope: Local to "+v\scope\name EndIf WriteLine output,"Type: "+v\vtype WriteLine output,"Constant: "+v\init If v\vtype=ev_FLOAT Then WriteLine output,"Value: "+v\f If v\vtype=ev_STRING Then WriteLine output,"Value: "+v\s If v\vtype=ev_ENTITY Then WriteInt output,"Handle: "+v\e If v\array=True Then WriteLine output,"Fields: "+v\e If v\vtype=ev_VECTOR WriteLine output,"Field X: "+v\vx\ID+", Value: "+v\vx\f WriteLine output,"Field Y: "+v\vy\ID+", Value: "+v\vy\f WriteLine output,"Field Z: "+v\vz\ID+", Value: "+v\vz\f EndIf ;Add other types if they are defined WriteLine output,"" Next WriteLine output,"" ;Functions WriteLine output,"Functions:" WriteLine output,"" For f=Each fdef If f\name="main" Then pr_main=f\code WriteLine output,"Name: "+f\name WriteLine output,"Start offset: "+f\code WriteLine output,"Return type: "+f\rtype WriteLine output,"Builtin: "+f\builtin WriteLine output,"First local: "+f\fvar WriteLine output,"Last local: "+f\lvar WriteLine output,"No. parameters: "+f\num_parms For i=0 To f\num_parms-1 WriteLine output," Parameter "+i+" Name: "+f\parm_name[i] WriteLine output," Parameter "+i+" Type: "+f\parm_type[i] WriteLine output," Parameter "+i+" ID: "+f\parm[i] Next WriteLine output,"" Next WriteLine output,"" If pr_main>-1 Then WriteLine output,"Entry point: Instruction "+pr_main:Else WriteLine output,"Entry point not found!" WriteLine output,"" ;Instructions WriteLine output,"Instructions:" WriteLine output,"" For s=Each statement_t WriteLine output,s\ID+": "+opcode[s\op]\opname+" : "+s\a+" : "+s\b+" : "+s\c WriteLine output,"" Next WriteLine output,"" CloseFile output End Function 2. Its header ;Blitz3D QuakeC Compiler ;======================= ;Header ;------ Const src_EOF=255 ;End of source file character Const MAX_NAME=64 ;Maximum length for names. Not really necessary Const MAX_PARMS=8 ;Maximum number of function parameters Const NUM_OPCODES=41 ;Number of opcodes Const MAX_ERRORS=100 ;Maximum number of definition errors before it gives up Const MAX_VARS=1000 ;These won't stop compilation if exceeded, Const MAX_FUNCS=100 ;but the compiler will issue a warning, as Const MAX_OPS=10000 ;they are important to the VM Const TOP_PRIORITY=6 Const NOT_PRIORITY=4 Const STACKID=-1 Const NULLVAR=-2 Const FILE_EXTENSION$=".c" ;Whatever you prefer (or your favourite IDE prefers) Global pr_dumpasm ;True to write a human-legible output file Global pr_dumpsrc ;True to output the source as read by the compiler (all one file, no directives) Global pr_filename$ ;The source file's name Global pr_fileout$ ;The output file's name Global pr_asmfile$ ;The "asm" file's name, if required Global pr_tempsrc$ ;The debug source file, if required Global pr_comp_err ;Number of compiled errors Type sourcefile ;Just a filehandle, but having them in a linked list is useful Field h End Type Type macro ;As defined with #define. No regular expressions, just cut and paste Field tok$ ;Constant token to use in source Field def$ ;Definition End Type Type eval_t ;Originally a union Field st$ Field fl# Field vec#[2] ;Will have to add other fields for custom types to this End Type Type fdef ;Function definition Field ID Field name$ Field code ;offset of first statement Field rtype ;Return type Field builtin ;0 for scripted function, or number for a native function Field num_parms ;Number of parameters (-1=variable) Field parmcount ;Number of parameters when called (for variable argument functions) Field fvar,lvar ;First and last variables local to function (including parameters) by ID Field parm_name$[MAX_PARMS-1] Field parm_type[MAX_PARMS-1] Field parm[MAX_PARMS] ;Store the ID rather than the vdef itself Field defined ;Function was defined and not just prototyped End Type Type vdef ;Variable definition Field ID Field name$ Field scope.fdef Field vtype Field init ;Initialised at declaration (ie. a constant) Field array ;True if this is an array header Field f#,s$,e Field vx.vdef,vy.vdef,vz.vdef End Type Type opcode_t ;Opcode definition Field name$,opname$ Field priority#,ra Field type_a,type_b,type_c End Type Type statement_t ;Statement Field ID Field op,a,b,c End Type Global sourcebank ;The source code, loaded into memory Global pr_source_line ;Current line in said code Global pr_file_p ;Current position in sourcebank Global pr_scope.fdef ;Current scope Global numstatements,fcounter,ret_arg[MAX_PARMS-1] Global vcounter=1;+MAX_PARMS Global def_ret.vdef=New vdef def_ret\name="returnbuffer" ;Stores function return value def_ret\ID=-1 Const tt_EOF=1,tt_NAME=2,tt_PUNCT=3,tt_IMMEDIATE=4 Global pr_token$,pr_token_type ;PTT: as above Global pr_immediate_type,pr_fdef_type,pr_fdef_parms,pr_fdef_ptype[MAX_PARMS-1],pr_fdef_pname$[MAX_PARMS-1] Global pr_immediate.eval_t=New eval_t Const MAX_SYMBOLS=26 Global pr_punctuation$[MAX_SYMBOLS] ;longer symbols must be before a shorter partial match pr_punctuation[0]="&&" pr_punctuation[1]="||" pr_punctuation[2]="<=" pr_punctuation[3]=">=" pr_punctuation[4]="==" pr_punctuation[5]="!=" pr_punctuation[6]=";" pr_punctuation[7]="," pr_punctuation[8]="!" pr_punctuation[9]="*" pr_punctuation[10]="/" pr_punctuation[11]="(" pr_punctuation[12]=")" pr_punctuation[13]="-" pr_punctuation[14]="+" pr_punctuation[15]="=" pr_punctuation[16]="[" pr_punctuation[17]="]" pr_punctuation[18]="{" pr_punctuation[19]="}" pr_punctuation[20]="..." pr_punctuation[21]="." pr_punctuation[22]="<" pr_punctuation[23]=">" pr_punctuation[24]="#" pr_punctuation[25]="&" pr_punctuation[26]="|" ;Type constants ;etype_t - enum: Const ev_VOID=1, ev_STRING=2, ev_FLOAT=3, ev_VECTOR=4, ev_ENTITY=5, ev_FUNCTION=6 ;Add desired custom types to this list ;Opcode definitions Global opcode.opcode_t[NUM_OPCODES] Local op.opcode_t Const OP_DONE = 0 :op=New opcode_t:op\name="<DONE>" :op\opname="DONE" :op\priority=-1:op\ra=False:op\type_a=ev_ENTITY :op\type_b=ev_FIELD :op\type_c=ev_VOID :opcode[OP_DONE]=op Const OP_MUL_F = 1 :op=New opcode_t:op\name="*" :op\opname="MUL_F" :op\priority= 2:op\ra=False:op\type_a=ev_FLOAT :op\type_b=ev_FLOAT :op\type_c=ev_FLOAT :opcode[OP_MUL_F]=op Const OP_MUL_V = 2 :op=New opcode_t:op\name="*" :op\opname="MUL_V" :op\priority= 2:op\ra=False:op\type_a=ev_VECTOR :op\type_b=ev_VECTOR :op\type_c=ev_FLOAT :opcode[OP_MUL_V]=op Const OP_MUL_FV = 3 :op=New opcode_t:op\name="*" :op\opname="MUL_FV" :op\priority= 2:op\ra=False:op\type_a=ev_FLOAT :op\type_b=ev_VECTOR :op\type_c=ev_VECTOR :opcode[OP_MUL_FV]=op Const OP_MUL_VF = 4 :op=New opcode_t:op\name="*" :op\opname="MUL_VF" :op\priority= 2:op\ra=False:op\type_a=ev_VECTOR :op\type_b=ev_FLOAT :op\type_c=ev_VECTOR :opcode[OP_MUL_VF]=op Const OP_DIV_F = 5 :op=New opcode_t:op\name="/" :op\opname="DIV" :op\priority= 2:op\ra=False:op\type_a=ev_FLOAT :op\type_b=ev_FLOAT :op\type_c=ev_FLOAT :opcode[OP_DIV_F]=op Const OP_ADD_F = 6 :op=New opcode_t:op\name="+" :op\opname="ADD_F" :op\priority= 3:op\ra=False:op\type_a=ev_FLOAT :op\type_b=ev_FLOAT :op\type_c=ev_FLOAT :opcode[OP_ADD_F]=op Const OP_ADD_V = 7 :op=New opcode_t:op\name="+" :op\opname="ADD_V" :op\priority= 3:op\ra=False:op\type_a=ev_VECTOR :op\type_b=ev_VECTOR :op\type_c=ev_VECTOR :opcode[OP_ADD_V]=op Const OP_SUB_F = 8 :op=New opcode_t:op\name="-" :op\opname="SUB_F" :op\priority= 3:op\ra=False:op\type_a=ev_FLOAT :op\type_b=ev_FLOAT :op\type_c=ev_FLOAT :opcode[OP_SUB_F]=op Const OP_SUB_V = 9 :op=New opcode_t:op\name="-" :op\opname="SUB_V" :op\priority= 3:op\ra=False:op\type_a=ev_VECTOR :op\type_b=ev_VECTOR :op\type_c=ev_VECTOR :opcode[OP_SUB_V]=op Const OP_CONC_S = 10:op=New opcode_t:op\name="+" :op\opname="CONC_S" :op\priority= 3:op\ra=False:op\type_a=ev_STRING :op\type_b=ev_STRING :op\type_c=ev_STRING :opcode[OP_CONC_S]=op Const OP_EQ_F = 11:op=New opcode_t:op\name="==" :op\opname="EQ_F" :op\priority= 4:op\ra=False:op\type_a=ev_FLOAT :op\type_b=ev_FLOAT :op\type_c=ev_FLOAT :opcode[OP_EQ_F]=op Const OP_EQ_V = 12:op=New opcode_t:op\name="==" :op\opname="EQ_V" :op\priority= 4:op\ra=False:op\type_a=ev_VECTOR :op\type_b=ev_VECTOR :op\type_c=ev_FLOAT :opcode[OP_EQ_V]=op Const OP_EQ_S = 13:op=New opcode_t:op\name="==" :op\opname="EQ_S" :op\priority= 4:op\ra=False:op\type_a=ev_STRING :op\type_b=ev_STRING :op\type_c=ev_FLOAT :opcode[OP_EQ_S]=op Const OP_EQ_E = 14:op=New opcode_t:op\name="==" :op\opname="EQ_E" :op\priority= 4:op\ra=False:op\type_a=ev_ENTITY :op\type_b=ev_ENTITY :op\type_c=ev_FLOAT :opcode[OP_EQ_E]=op Const OP_NE_F = 15:op=New opcode_t:op\name="!=" :op\opname="NE_F" :op\priority= 4:op\ra=False:op\type_a=ev_FLOAT :op\type_b=ev_FLOAT :op\type_c=ev_FLOAT :opcode[OP_NE_F]=op Const OP_NE_V = 16:op=New opcode_t:op\name="!=" :op\opname="NE_V" :op\priority= 4:op\ra=False:op\type_a=ev_VECTOR :op\type_b=ev_VECTOR :op\type_c=ev_FLOAT :opcode[OP_NE_V]=op Const OP_NE_S = 17:op=New opcode_t:op\name="!=" :op\opname="NE_S" :op\priority= 4:op\ra=False:op\type_a=ev_STRING :op\type_b=ev_STRING :op\type_c=ev_FLOAT :opcode[OP_NE_S]=op Const OP_NE_E = 18:op=New opcode_t:op\name="!=" :op\opname="NE_E" :op\priority= 4:op\ra=False:op\type_a=ev_ENTITY :op\type_b=ev_ENTITY :op\type_c=ev_FLOAT :opcode[OP_NE_E]=op Const OP_LE = 19:op=New opcode_t:op\name="<=" :op\opname="LE" :op\priority= 4:op\ra=False:op\type_a=ev_FLOAT :op\type_b=ev_FLOAT :op\type_c=ev_FLOAT :opcode[OP_LE]=op Const OP_GE = 20:op=New opcode_t:op\name=">=" :op\opname="GE" :op\priority= 4:op\ra=False:op\type_a=ev_FLOAT :op\type_b=ev_FLOAT :op\type_c=ev_FLOAT :opcode[OP_GE]=op Const OP_LT = 21:op=New opcode_t:op\name="<" :op\opname="LT" :op\priority= 4:op\ra=False:op\type_a=ev_FLOAT :op\type_b=ev_FLOAT :op\type_c=ev_FLOAT :opcode[OP_LT]=op Const OP_GT = 22:op=New opcode_t:op\name=">" :op\opname="GT" :op\priority= 4:op\ra=False:op\type_a=ev_FLOAT :op\type_b=ev_FLOAT :op\type_c=ev_FLOAT :opcode[OP_GT]=op Const OP_STORE_F = 23:op=New opcode_t:op\name="=" :op\opname="STORE_F" :op\priority= 5:op\ra=True :op\type_a=ev_FLOAT :op\type_b=ev_FLOAT :op\type_c=ev_FLOAT :opcode[OP_STORE_F]=op Const OP_STORE_V = 24:op=New opcode_t:op\name="=" :op\opname="STORE_V" :op\priority= 5:op\ra=True :op\type_a=ev_VECTOR :op\type_b=ev_VECTOR :op\type_c=ev_VECTOR :opcode[OP_STORE_V]=op Const OP_STORE_S = 25:op=New opcode_t:op\name="=" :op\opname="STORE_S" :op\priority= 5:op\ra=True :op\type_a=ev_STRING :op\type_b=ev_STRING :op\type_c=ev_STRING :opcode[OP_STORE_S]=op Const OP_STORE_ENT = 26:op=New opcode_t:op\name="=" :op\opname="STORE_ENT" :op\priority= 5:op\ra=True :op\type_a=ev_ENTITY :op\type_b=ev_ENTITY :op\type_c=ev_ENTITY :opcode[OP_STORE_ENT]=op Const OP_RETURN = 27:op=New opcode_t:op\name="<RETURN>":op\opname="RETURN" :op\priority=-1:op\ra=False:op\type_a=ev_VOID :op\type_b=ev_VOID :op\type_c=ev_VOID :opcode[OP_RETURN]=op Const OP_NOT_F = 28:op=New opcode_t:op\name="!" :op\opname="NOT_F" :op\priority=-1:op\ra=False:op\type_a=ev_FLOAT :op\type_b=ev_VOID :op\type_c=ev_FLOAT :opcode[OP_NOT_F]=op Const OP_NOT_V = 29:op=New opcode_t:op\name="!" :op\opname="NOT_V" :op\priority=-1:op\ra=False:op\type_a=ev_VECTOR :op\type_b=ev_VOID :op\type_c=ev_FLOAT :opcode[OP_NOT_V]=op Const OP_NOT_S = 30:op=New opcode_t:op\name="!" :op\opname="NOT_S" :op\priority=-1:op\ra=False:op\type_a=ev_VECTOR :op\type_b=ev_VOID :op\type_c=ev_FLOAT :opcode[OP_NOT_S]=op Const OP_NOT_ENT = 31:op=New opcode_t:op\name="!" :op\opname="NOT_ENT" :op\priority=-1:op\ra=False:op\type_a=ev_ENTITY :op\type_b=ev_VOID :op\type_c=ev_FLOAT :opcode[OP_NOT_ENT]=op Const OP_IF = 32:op=New opcode_t:op\name="<IF>" :op\opname="If" :op\priority=-1:op\ra=False:op\type_a=ev_FLOAT :op\type_b=ev_FLOAT :op\type_c=ev_VOID :opcode[OP_IF]=op Const OP_IFNOT = 33:op=New opcode_t:op\name="<IFNOT>" :op\opname="IFNOT" :op\priority=-1:op\ra=False:op\type_a=ev_FLOAT :op\type_b=ev_FLOAT :op\type_c=ev_VOID :opcode[OP_IFNOT]=op Const OP_CALL = 34:op=New opcode_t:op\name="<CALL>" :op\opname="CALL" :op\priority=-1:op\ra=False:op\type_a=ev_FUNCTION:op\type_b=ev_FLOAT :op\type_c=ev_FLOAT :opcode[OP_CALL]=op Const OP_GOTO = 35:op=New opcode_t:op\name="<GOTO>" :op\opname="GOTO" :op\priority=-1:op\ra=False:op\type_a=ev_FLOAT :op\type_b=ev_VOID :op\type_c=ev_VOID :opcode[OP_GOTO]=op Const OP_AND = 36:op=New opcode_t:op\name="&&" :op\opname="AND" :op\priority= 6:op\ra=False:op\type_a=ev_FLOAT :op\type_b=ev_FLOAT :op\type_c=ev_FLOAT :opcode[OP_AND]=op Const OP_OR = 37:op=New opcode_t:op\name="||" :op\opname="OR" :op\priority= 6:op\ra=False:op\type_a=ev_FLOAT :op\type_b=ev_FLOAT :op\type_c=ev_FLOAT :opcode[OP_OR]=op Const OP_BITAND = 38:op=New opcode_t:op\name="&" :op\opname="BITAND" :op\priority= 2:op\ra=False:op\type_a=ev_FLOAT :op\type_b=ev_FLOAT :op\type_c=ev_FLOAT :opcode[OP_BITAND]=op Const OP_BITOR = 39:op=New opcode_t:op\name="|" :op\opname="BITOR" :op\priority= 2:op\ra=False:op\type_a=ev_FLOAT :op\type_b=ev_FLOAT :op\type_c=ev_FLOAT :opcode[OP_BITOR]=op Const OP_ARRAY = 40:op=New opcode_t:op\name="<ARRAY>" :op\opname="ARRAY" :op\priority=-1:opcode[OP_ARRAY]=op opcode[NUM_OPCODES]=Null 3. The interpreter ;Blitz3D QuakeC Interpreter ;========================== ;Main ;---- ;1. Setup definitions and declare globals Include "QCVMh.bb" filename$="test.qcx" ;2. Load Scripts Write "Loading "+filename+"... " t.Thread=VM_LoadScript(filename) Print "done." ;3. Run Scripts start=MilliSecs() ;Let's time it... ; - t\runstate=1 For i=1 To 100000 VM_RunScripts(1) If t\runstate=2 Then VM_ResetScript(t):t\runstate=1 Next Print MilliSecs()-start ;4. Free Scripts VM_FreeScript(t) WaitKey End Function VM_LoadScript.Thread(fname$) ;Load a script from a precompiled .qcx file scriptfile=ReadFile(fname) t.Thread=New Thread ;Read script header vcount=ReadInt(scriptfile) ;Number of variables and Caseants fcount=ReadInt(scriptfile) ;Number of functions scount=ReadInt(scriptfile) ;Number of instructions ;Create the variable definitions separately first so that fields can be referenced when their IDs are loaded For vc=0 To vcount-1 v.vdef=New vdef t\v[vc]=v t\vcount=t\vcount+1 Next ;Load variables and constants For vc=0 To vcount-1 v.vdef=t\v[vc] v\name=ReadString(scriptfile) v\scope=ReadInt(scriptfile) v\vtype=ReadByte(scriptfile) v\array=ReadByte(scriptfile) If v\vtype=ev_FLOAT Then v\f=ReadFloat(scriptfile) If v\vtype=ev_STRING Then v\s=ReadString(scriptfile) If v\vtype=ev_ENTITY Or v\array=True Then v\e=ReadInt ;Not much point storing object handles... but you can put other ints here If v\vtype=ev_VECTOR v\vx=t\v[ReadInt(scriptfile)] v\vy=t\v[ReadInt(scriptfile)] v\vz=t\v[ReadInt(scriptfile)] EndIf ;Add other types here if required Next t\junkptr=vc:t\v[vc]=New vdef ;"Junk" variable to dump unwanted results ;Load function definitions For fc=0 To fcount-1 f.fdef=New fdef f\ID=fc f\name=ReadString(scriptfile) f\rtype=ReadByte(scriptfile) f\code=ReadInt(scriptfile) f\builtin=ReadShort(scriptfile) f\fvar=ReadInt(scriptfile) f\lvar=ReadInt(scriptfile) f\num_parms=ReadByte(scriptfile) For i=0 To f\num_parms-1 f\parm_name[i]=ReadString(scriptfile) f\parm_type[i]=ReadByte(scriptfile) f\parm[i]=t\v[ReadInt(scriptfile)] Next t\f[fc]=f t\fcount=t\fcount+1 If f\name="main" Then t\cscope=f:t\main=f Next t\insptr=ReadInt(scriptfile) ;Set the instruction pointer to the start of main() ;Load instructions For sc=0 To scount-1 s.sdef=New sdef s\op=ReadByte(scriptfile) s\a=ReadInt(scriptfile) s\b=ReadInt(scriptfile) s\c=ReadInt(scriptfile) t\s[sc]=s t\scount=t\scount+1 Next CloseFile scriptfile For vc=1 To STACKSIZE ;Create a stack t\stack[vc]=New vdef t\stack[vc]\vx=New vdef ;Since stacked values could hold any type they need all fields t\stack[vc]\vy=New vdef t\stack[vc]\vz=New vdef Next For vc=1 To LOCALSIZE ;Create another stack t\localstack[vc]=New vdef t\localstack[vc]\vx=New vdef t\localstack[vc]\vy=New vdef t\localstack[vc]\vz=New vdef Next Return t End Function Function VM_RunScripts(itns=1) ;Update the scripts by a given increment (or by default, probably run them all through) Local s.sdef,a.vdef,b.vdef,c.vdef,f.fdef,t.Thread For t=Each Thread If t\runstate=1 For cycle=1 To itns op=t\s[t\insptr]\op:s=t\s[t\insptr] If s\a=STACKID Then a=t\stack[t\stkptr]:t\stkptr=t\stkptr-1:ElseIf s\a<>NULLVAR Then a=t\v[s\a] If s\b=STACKID Then b=t\stack[t\stkptr]:t\stkptr=t\stkptr-1:ElseIf s\b<>NULLVAR Then b=t\v[s\b] If s\c=STACKID Then t\stkptr=t\stkptr+1:c=t\stack[t\stkptr]:ElseIf s\c<>NULLVAR Then c=t\v[s\c] If op<21 ;Binary partitioning massively reduces access time for ops further down the list If op<11 ;Adding more layers may grant further speed boosts - for readability's sake Select op ;let's keep it to two. Also, this does mean the ops have to be in numerical Case OP_DONE ;order, which would not be the case in a regular Select structure. If t\cscope=t\main Then t\runstate=2:Exit t\cscope=t\f[t\localstack[t\locptr]\e] t\insptr=t\localstack[t\locptr-1]\e t\locptr=t\locptr-2 For i=t\cscope\lvar To t\cscope\fvar Step -1 If t\v[i]\vtype=ev_FLOAT t\v[i]\f=t\localstack[t\locptr]\f ElseIf t\v[i]\vtype=ev_STRING t\v[i]\s=t\localstack[t\locptr]\s ElseIf t\v[i]\vtype=ev_ENTITY t\v[i]\e=t\localstack[t\locptr]\e Else ;Vector. Remember to add other types if using them t\v[i]\vx\f=t\localstack[t\locptr]\vx\f t\v[i]\vy\f=t\localstack[t\locptr]\vy\f t\v[i]\vz\f=t\localstack[t\locptr]\vz\f EndIf t\locptr=t\locptr-1 Next Case OP_MUL_F c\f=a\f*b\f:c\vtype=ev_FLOAT Case OP_MUL_V c\f=a\vx\f*b\vx\f+a\vy\f*b\vy\f+a\vz\f*b\vz\f:c\vtype=ev_FLOAT Case OP_MUL_FV c\vx\f=a\f*b\vx\f c\vy\f=a\f*b\vy\f c\vz\f=a\f*b\vz\f c\vtype=ev_VECTOR Case OP_MUL_VF c\vx\f=a\vx\f*b\f c\vy\f=a\vy\f*b\f c\vz\f=a\vz\f*b\f c\vtype=ev_VECTOR Case OP_DIV_F c\f=a\f/b\f:c\vtype=ev_FLOAT Case OP_ADD_F c\f=a\f+b\f:c\vtype=ev_FLOAT Case OP_ADD_V c\vx\f=a\vx\f+b\vx\f c\vy\f=a\vy\f+b\vy\f c\vz\f=a\vz\f+b\vz\f c\vtype=ev_VECTOR Case OP_SUB_F c\f=a\f-b\f:c\vtype=ev_FLOAT Case OP_SUB_V c\vx\f=a\vx\f-b\vx\f c\vy\f=a\vy\f-b\vy\f c\vz\f=a\vz\f-b\vz\f c\vtype=ev_VECTOR Case OP_CONC_S c\s=a\s+b\s:c\vtype=ev_STRING End Select Else Select op Case OP_EQ_F c\f=(a\f=b\f):c\vtype=ev_FLOAT Case OP_EQ_V c\f=(a\vx\f=b\vx\f) And (a\vy\f=b\vy\f) And (a\vz\f=b\vz\f):c\vtype=ev_FLOAT Case OP_EQ_S c\f=(a\s=b\s):c\vtype=ev_FLOAT Case OP_EQ_E c\f=(a\e=b\e):c\vtype=ev_FLOAT Case OP_NE_F c\f=(a\f<>b\f):c\vtype=ev_FLOAT Case OP_NE_V c\f=(a\vx\f<>b\vx\f) Or (a\vy\f<>b\vy\f) Or (a\vz\f<>b\vz\f):c\vtype=ev_FLOAT Case OP_NE_S c\f=(a\s<>b\s):c\vtype=ev_FLOAT Case OP_NE_E c\f=(a\e<>b\e):c\vtype=ev_FLOAT Case OP_LE c\f=a\f<=b\f:c\vtype=ev_FLOAT Case OP_GE c\f=a\f>=b\f:c\vtype=ev_FLOAT End Select EndIf Else If op<31 Select op Case OP_LT c\f=a\f<b\f:c\vtype=ev_FLOAT Case OP_GT c\f=a\f>b\f:c\vtype=ev_FLOAT Case OP_STORE_F c\f=a\f:c\vtype=ev_FLOAT Case OP_STORE_V If a\vtype=ev_FLOAT ;This is also the default store instruction for function args so it stores whatever c\f=a\f ElseIf a\vtype=ev_STRING c\s=a\s ElseIf a\vtype=ev_ENTITY c\e=a\e Else c\vx\f=a\vx\f c\vy\f=a\vy\f c\vz\f=a\vz\f EndIf c\vtype=a\vtype Case OP_STORE_S c\s=a\s:c\vtype=ev_STRING Case OP_STORE_ENT c\e=a\e:c\vtype=ev_ENTITY Case OP_RETURN i=t\localstack[t\locptr]\e ;Pop the return address off the localstack t\locptr=t\locptr-1 If s\a<>NULLVAR If i=STACKID Then t\stkptr=t\stkptr+1:c=t\stack[t\stkptr]:Else c=t\v[i] If a\vtype=ev_FLOAT ;Put stuff into it c\f=a\f:c\vtype=ev_FLOAT ElseIf a\vtype=ev_STRING c\s=a\s:c\vtype=ev_STRING ElseIf a\vtype=ev_ENTITY c\e=a\e:c\vtype=ev_ENTITY Else c\vx\f=a\vx\f c\vy\f=a\vy\f c\vz\f=a\vz\f c\vtype=ev_VECTOR EndIf EndIf Case OP_NOT_F c\f=Not a\f:c\vtype=ev_FLOAT Case OP_NOT_V c\f=(Not a\vx\f) And (Not a\vy\f) And (Not a\vz\f):c\vtype=ev_FLOAT Case OP_NOT_S c\f=Not a\s:c\vtype=ev_FLOAT End Select Else Select op Case OP_NOT_ENT c\f=Not a\e:c\vtype=ev_FLOAT Case OP_IF If a\f Then t\insptr=s\b Case OP_IFNOT If Not a\f Then t\insptr=s\b Case OP_CALL If t\f[s\a]\builtin>0 VM_CallBuiltin(t,s\a,s\b,c) If s\c=STACKID Then t\stkptr=t\stkptr+1 Else If s\c=NULLVAR Then s\c=t\junkptr f=t\f[s\a] For i=t\cscope\fvar To t\cscope\lvar ;Stack locals for current function t\locptr=t\locptr+1 If t\v[i]\vtype=ev_FLOAT t\localstack[t\locptr]\f=t\v[i]\f ElseIf t\v[i]\vtype=ev_STRING t\localstack[t\locptr]\s=t\v[i]\s ElseIf t\v[i]\vtype=ev_ENTITY t\localstack[t\locptr]\e=t\v[i]\e Else ;Vector. Remember to add other types if using them t\localstack[t\locptr]\vx\f=t\v[i]\vx\f t\localstack[t\locptr]\vy\f=t\v[i]\vy\f t\localstack[t\locptr]\vz\f=t\v[i]\vz\f EndIf Next t\localstack[t\locptr+1]\e=t\insptr ;Store the current instruction (to return here) t\localstack[t\locptr+2]\e=t\cscope\ID ;Store the current scope ID t\localstack[t\locptr+3]\e=s\c ;Store the ID to return a value to t\locptr=t\locptr+3 t\cscope=f ;Update the scope t\insptr=f\code-1 ;Set the instruction pointer to the start of the function For i=0 To s\b-1 If f\parm[i]\vtype=ev_FLOAT ;Pop parameters off the stack f\parm[i]\f=t\stack[t\stkptr-i]\f ElseIf f\parm[i]\vtype=ev_STRING f\parm[i]\s=t\stack[t\stkptr-i]\s ElseIf f\parm[i]\vtype=ev_ENTITY f\parm[i]\e=t\stack[t\stkptr-i]\e Else ;Vector. Remember to add other types if using them f\parm[i]\vx\f=t\stack[t\stkptr-i]\vx\f f\parm[i]\vy\f=t\stack[t\stkptr-i]\vy\f f\parm[i]\vz\f=t\stack[t\stkptr-i]\vz\f EndIf Next t\stkptr=t\stkptr-i EndIf Case OP_GOTO t\insptr=s\a Case OP_AND c\f=(a\f<>0) And (b\f<>0):c\vtype=ev_FLOAT Case OP_OR c\f=(a\f<>0) Or (b\f<>0):c\vtype=ev_FLOAT Case OP_BITAND c\f=a\f And b\f:c\vtype=ev_FLOAT Case OP_BITOR c\f=a\f Or b\f:c\vtype=ev_FLOAT Case OP_ARRAY If a\vtype=ev_VECTOR b=t\v[s\a+4+b\f*4] c\vx\f=b\vx\f:c\vy\f=b\vy\f:c\vz\f=b\vz\f c\vtype=ev_VECTOR Else b=t\v[s\a+1+b\f] If a\vtype=ev_FLOAT Then c\f=b\f:c\vtype=ev_FLOAT If a\vtype=ev_STRING Then c\s=b\s:c\vtype=ev_STRING If a\vtype=ev_ENTITY Then c\e=b\e:c\vtype=ev_ENTITY EndIf Default VM_RuntimeError(t,"Bad opcode") End Select EndIf EndIf t\insptr=t\insptr+1 Next EndIf Next End Function Function VM_ResetScript(t.Thread) ;Set the pointers back to the beginning t\insptr=t\main\code t\stkptr=0 t\locptr=0 t\cscope=t\main t\runstate=0 End Function Function VM_FreeScript(t.Thread) ;Delete a script and its variables Local i ;Delete variables For i=0 To t\vcount ;One extra Delete t\v[i] Next ;Delete functions For i=0 To t\fcount-1 Delete t\f[i] Next ;Delete instructions For i=0 To t\scount-1 Delete t\s[i] Next ;Delete variable stack For i=1 To STACKSIZE Delete t\stack[i]\vx Delete t\stack[i]\vy Delete t\stack[i]\vz Delete t\stack[i] Next ;Delete function stack For i=1 To LOCALSIZE Delete t\localstack[i]\vx Delete t\localstack[i]\vy Delete t\localstack[i]\vz Delete t\localstack[i] Next ;Delete the thread Delete t End Function Function VM_RuntimeError(t.Thread,err$) Print "" Print "ERROR at instruction "+t\insptr+": "+err Print "Execution halted, press any key to exit." WaitKey End End Function Function VM_CallBuiltin(t.Thread,ID,args,retval.vdef) Local v.vdef ;Builtin functions MUST be prototyped in the script itself according to the format: ; type (argtype argname, argtype2 argname2,...) name = #ID; ;eg. void (entity ent, float x, float y, float z) moveent = #13; ;If there are several in use it may be faster to add them to the opcodes (where possible) ;It should also be faster to implement a binary partition in this list, but this is only an example Select ID Case BF_RINT ;Int retval\f=Int(t\stack[t\stkptr]\f) t\stkptr=stkptr-1 Case BF_FLOOR ;Floor retval\f=Floor(t\stack[t\stkptr]\f) t\stkptr=stkptr-1 Case BF_CEIL ;Ceil retval\f=Ceil(t\stack[t\stkptr]\f) t\stkptr=stkptr-1 Case BF_ABS ;Abs retval\f=Abs(t\stack[t\stkptr]\f) t\stkptr=stkptr-1 Case BF_RND ;Rnd retval\f=Rnd(t\stack[t\stkptr]\f,t\stack[t\stkptr-1]\f) t\stkptr=t\stkptr-2 Case BF_FTOS ;String retval\f=Int(t\stack[t\stkptr]\f) t\stkptr=stkptr-1 Case BF_VYAW ;Vector yaw v=t\stack[t\stkptr] retval\f=ATan2(v\vx\f,v\vz\f) t\stkptr=stkptr-1 Case BF_VNORM ;Normalise vector v=t\stack[t\stkptr] If v\vx\f>v\vy\f And v\vx\f>v\vz\f v\vy\f=v\vy\f/v\vx\f:v\vz\f=v\vz\f/v\vx\f:v\vx\f=1 ElseIf v\vy\f>v\vx\f And v\vy\f>v\vz\f v\vx\f=v\vx\f/v\vy\f:v\vz\f=v\vz\f/v\vy\f:v\vy\f=1 Else ;vz v\vx\f=v\vx\f/v\vz\f:v\vy\f=v\vy\f/v\vz\f:v\vz\f=1 EndIf t\stkptr=stkptr-1 Case BF_VLEN ;Vector length v=t\stack[t\stkptr] retval\f=Sqr(v\vx\f*v\vx\f+v\vy\f*v\vy\f+v\vz\f*v\vz\f) t\stkptr=stkptr-1 Case BF_VTOS ;Vector to string v=t\stack[t\stkptr] retval\s=Str(v\vx\f+" "+v\vy\f+" "+v\vz\f) t\stkptr=stkptr-1 Case BF_PRINT ;Print Print t\stack[t\stkptr]\s t\stkptr=stkptr-1 Case BF_CCUBE ;Create cube retval\e=CreateCube() Case BF_EMOVE ;Move entity MoveEntity t\stack[t\stkptr]\e,t\stack[t\stkptr-1]\f,t\stack[t\stkptr-2]\f,t\stack[t\stkptr-3]\f t\stkptr=t\stkptr-4 Case BF_ETRANS ;Translate entity TranslateEntity t\stack[t\stkptr]\e,t\stack[t\stkptr-1]\f,t\stack[t\stkptr-2]\f,t\stack[t\stkptr-3]\f t\stkptr=t\stkptr-4 Case BF_EROT ;Rotate entity RotateEntity t\stack[t\stkptr]\e,t\stack[t\stkptr-1]\f,t\stack[t\stkptr-2]\f,t\stack[t\stkptr-3]\f t\stkptr=t\stkptr-4 Case BF_ETURN ;Turn entity TurnEntity t\stack[t\stkptr]\e,t\stack[t\stkptr-1]\f,t\stack[t\stkptr-2]\f,t\stack[t\stkptr-3]\f t\stkptr=t\stkptr-4 ;If the value goes back on the stack, it will be handled in the op list Default VM_RuntimeError(t,"Bad builtin ID") End Select End Function 4. The interpreter's header [codebox] ;Blitz3D QuakeC Interpreter ;========================== ;Header ;------ Const MAX_VARS=1000 ; Const MAX_FUNCS=100 ;; Const MAX_OPS=10000 ;;; These are constants because the values are held in Blitz arrays. Feel free to increase them if necessary Const STACKSIZE=100 ;; Const LOCALSIZE=500 ; Const MAX_PARMS=8 Const STACKID=-1 Const NULLVAR=-2 Type Thread Field runstate ;0=ready, 1=running, 2=done Field vcount ;Number of variables and constants Field fcount ;Number of functions Field scount ;Number of instructions Field v.vdef[MAX_VARS] ;List of variables and constants Field f.fdef[MAX_FUNCS] ;List of functions Field s.sdef[MAX_OPS] ;List of instructions Field main.fdef ;Function main() Field insptr ;Current instruction Field cscope.fdef ;Current scope Field stack.vdef[STACKSIZE],stkptr Field localstack.vdef[LOCALSIZE],locptr Field junkptr ;Address of "junk value" to dump unwanted results End Type Type fdef ;Function definition Field ID Field name$ Field code ;offset of first statement Field rtype ;Return type Field builtin ;0 for scripted function, or number for a native function Field num_parms ;Number of parameters (-1=variable) Field fvar,lvar ;First and last variables local to function (including parameters) by ID Field parm_name$[MAX_PARMS-1] Field parm_type[MAX_PARMS-1] Field parm.vdef[MAX_PARMS-1] ;Store the ID rather than the vdef itself End Type Type vdef ;Variable definition Field name$ Field scope Field vtype Field array ;True if this is an array header Field f#,s$,e ;Value (float, string, handle) Field vx.vdef,vy.vdef,vz.vdef ;Vector field pointers (float variables) ;Add fields for other types as required End Type Type sdef ;Instruction ; Field ID Field op,a,b,c End Type ;Type constants Const ev_VOID=1, ev_STRING=2, ev_FLOAT=3, ev_VECTOR=4, ev_ENTITY=5, ev_FUNCTION=6 ;Opcode constants Const OP_DONE = 0 Const OP_MUL_F = 1 Const OP_MUL_V = 2 Const OP_MUL_FV = 3 Const OP_MUL_VF = 4 Const OP_DIV_F = 5 Const OP_ADD_F = 6 Const OP_ADD_V = 7 Const OP_SUB_F = 8 Const OP_SUB_V = 9 Const OP_CONC_S = 10 Const OP_EQ_F = 11 Const OP_EQ_V = 12 Const OP_EQ_S = 13 Const OP_EQ_E = 14 Const OP_NE_F = 15 Const OP_NE_V = 16 Const OP_NE_S = 17 Const OP_NE_E = 18 Const OP_LE = 19 Const OP_GE = 20 Const OP_LT = 21 Const OP_GT = 22 Const OP_STORE_F = 23 Const OP_STORE_V = 24 Const OP_STORE_S = 25 Const OP_STORE_ENT = 26 Const OP_RETURN = 27 Const OP_NOT_F = 28 Const OP_NOT_V = 29 Const OP_NOT_S = 30 Const OP_NOT_ENT = 31 Const OP_IF = 32 Const OP_IFNOT = 33 Const OP_CALL = 34 Const OP_GOTO = 35 Const OP_AND = 36 Const OP_OR = 37 Const OP_BITAND = 38 Const OP_BITOR = 39 Const OP_ARRAY = 40 ;Const OP_CLEARSTACK = 41 ;Built-in function IDs Built-in functions MUST be prototyped in the script. Const BF_RINT =1 ;Here for example's sake. Maths functions like these could equally well just be opcodes Const BF_FLOOR =2 Const BF_CEIL =3 Const BF_ABS =4 Const BF_RND =5 Const BF_FTOS =6 Const BF_VYAW =7 Const BF_VNORM =8 Const BF_VLEN =9 Const BF_VTO

puki (Posted 2009) [#2]

This looks exciting.

Yasha (Posted 2009) [#3]

. (EDIT: As above, whole thing is being rewritten because this version has too many bugs to fix, the biggest one being the GPL. By all means play with it, but don't expect it to work as advertised. The "new version" will actually have a different name, featureset and syntax, due to the fact that trying to force the QuakeC peg into the Blitz3D hole is the root of far too much messing about. The only similarity is the use of three address code, because it's awesome.)