瀏覽代碼

Implemented "Release" keyword.
Fixed code-generation for short-ptr string conversion.
Fixed initialization of global arrays.

woollybah 11 年之前
父節點
當前提交
23e6057cbd
共有 7 個文件被更改,包括 74 次插入11 次删除
  1. 28 6
      ctranslator.bmx
  2. 7 3
      expr.bmx
  3. 1 1
      options.bmx
  4. 8 0
      parser.bmx
  5. 23 0
      stmt.bmx
  6. 1 1
      toker.bmx
  7. 6 0
      type.bmx

+ 28 - 6
ctranslator.bmx

@@ -169,7 +169,7 @@ Type TCTranslator Extends TTranslator
 		If TStringType( ty ) Then
 			If ty._flags & TType.T_CHAR_PTR Then
 				Return "$z"
-			Else If ty._flags & TType.T_CHAR_PTR Then
+			Else If ty._flags & TType.T_SHORT_PTR Then
 				Return "$w"
 			End If
 			Return "$" + p
@@ -458,7 +458,7 @@ t:+"NULLNULLNULL"
 
 	Method TransGlobalDecl$( munged$,init:TExpr, attrs:Int, ty:TType )
 		Local glob:String
-		
+
 		If Not (attrs & DECL_INITONLY) Then
 			glob :+"static " + TransType( init.exprType, munged )+" "
 		End If
@@ -470,6 +470,15 @@ t:+"NULLNULLNULL"
 			glob :+ indent + "if (" + munged + "==0) {~n"
 			glob :+ indent + "~t" + munged + "=" + init.Trans() + ";~n"
 			glob :+ indent + "}"
+		Else If TArrayExpr(init) And Not (attrs & DECL_INITONLY) Then
+			glob :+ "0;~n"
+			Emit glob
+			Emit "if (" + munged + "==0) {"
+			
+			glob = munged + "=" + init.Trans() + ";"
+			Emit glob
+			Emit "}"
+			glob = ""
 		Else
 			If init Then
 				If TFunctionPtrType(ty) Then
@@ -496,7 +505,11 @@ t:+"NULLNULLNULL"
 	Method CreateLocal2$( ty:TType, t$ )
 		Local tmp:TLocalDecl=New TLocalDecl.Create( "", ty,Null )
 		MungDecl tmp
-		Emit TransType(ty, "") + " " + tmp.munged + " = bbStringToCString" + Bra(t)+ ";"
+		If TShortType(ty) Then
+			Emit TransType(ty, "") + " " + tmp.munged + " = bbStringToWString" + Bra(t)+ ";"
+		Else
+			Emit TransType(ty, "") + " " + tmp.munged + " = bbStringToCString" + Bra(t)+ ";"
+		End If
 		customVarStack.Push(tmp.munged)
 		Return tmp.munged
 	End Method
@@ -570,7 +583,7 @@ t:+"NULLNULLNULL"
 	End Method
 
 	Method TransFunc$( decl:TFuncDecl,args:TExpr[],lhs:TExpr, sup:Int = False, scope:TScopeDecl = Null )
-'If decl.ident = "Sqr" DebugStop
+'If decl.ident = "LoadLibraryW" DebugStop
 		' for calling the super class method instead
 		Local tSuper:String
 		If sup Then
@@ -1242,7 +1255,12 @@ EndRem
 			'If TByteType(src) And Not IsPointerType(src, TType.T_BYTE, TType.T_POINTER) Return Bra("&"+t)
 
 			If TStringType(src) Then
-				Local tmp:String = CreateLocal2(NewPointerType(TType.T_BYTE), t)
+				Local tmp:String
+				If IsPointerType( dst, 0, TType.T_SHORT_PTR ) Then
+					tmp = CreateLocal2(NewPointerType(TType.T_SHORT), t)
+				Else
+					tmp = CreateLocal2(NewPointerType(TType.T_BYTE), t)
+				End If
 
 				Return tmp
 			End If
@@ -1817,7 +1835,11 @@ EndRem
 	Method TransEndStmt$( stmt:TEndStmt )
 		Emit "bbEnd();"
 	End Method
-	
+
+	Method TransReleaseStmt$( stmt:TReleaseStmt )
+		Emit "bbHandleRelease" + Bra(stmt.expr.Trans()) + ";"
+	End Method
+
 	Method TransFullName:String(decl:TDecl)
 		Local s:String
 		

+ 7 - 3
expr.bmx

@@ -421,6 +421,7 @@ Type TInvokeExpr Extends TExpr
 	End Method
 
 	Method Semant:TExpr()
+
 		If exprType Return Self
 
 		' handle Sgn, Asc and Chr keywords/functions for const values
@@ -863,7 +864,10 @@ Type TCastExpr Extends TExpr
 			If flags & CAST_EXPLICIT
 'DebugStop
 				'if both objects or both non-objects...
-				If (TObjectType(ty)<>Null)=(TObjectType(src)<>Null) exprType=ty
+				If (TObjectType(ty)<>Null)=(TObjectType(src)<>Null) Then
+					exprType=ty
+					Return Self
+				End If
 
 			'Else ' if not explicitly cast, we can't just auto-cast it ourselves here.
 				'If (TObjectType(ty)<>Null) And (TObjectType(src)<>Null) exprType=ty
@@ -918,7 +922,7 @@ Type TCastExpr Extends TExpr
 			Return Self
 		End If
 		
-		If TStringType(src) And (src._flags & TType.T_CHAR_PTR) And TStringType(ty) Then
+		If TStringType(src) And ((src._flags & TType.T_CHAR_PTR) Or (src._flags & TType.T_SHORT_PTR)) And TStringType(ty) Then
 			exprType = ty
 			Return Self
 		End If
@@ -943,7 +947,7 @@ Type TCastExpr Extends TExpr
 			End If
 		End If
 
-		If IsPointerType(ty, 0, TType.T_POINTER | TType.T_CHAR_PTR) Then
+		If IsPointerType(ty, 0, TType.T_POINTER | TType.T_CHAR_PTR | TType.T_SHORT_PTR) Then
 			If IsNumericType(src) And Not (src._flags & TType.T_VARPTR) Then
 				'If IsPointerType(ty,0,TType.T_POINTER) Then
 				'	exprType = TNumericType(src).ToPointer()

+ 1 - 1
options.bmx

@@ -25,7 +25,7 @@ SuperStrict
 
 Import "base.configmap.bmx"
 
-Const version:String = "0.18"
+Const version:String = "0.19"
 
 Const BUILDTYPE_APP:Int = 0
 Const BUILDTYPE_MODULE:Int = 1

+ 8 - 0
parser.bmx

@@ -1479,6 +1479,12 @@ Type TParser
 		_block.AddStmt New TThrowStmt.Create( expr )
 	End Method
 
+	Method ParseReleaseStmt()
+		Parse "release"
+		Local expr:TExpr = ParseExpr()
+		_block.AddStmt New TReleaseStmt.Create( expr )
+	End Method
+	
 	Method ParseAssertStmt()
 		Parse "assert"
 		Local expr:TExpr = ParseExpr()
@@ -1714,6 +1720,8 @@ Type TParser
 					Default
 						Err "Expecting loop statement"
 				End Select
+			Case "release"
+				ParseReleaseStmt()
 			Default
 				Local expr:TExpr=ParsePrimaryExpr( True )
 

+ 23 - 0
stmt.bmx

@@ -514,3 +514,26 @@ Type TEndStmt Extends TStmt
 		Return _trans.TransEndStmt( Self )
 	End Method
 End Type
+
+Type TReleaseStmt Extends TStmt
+	Field expr:TExpr
+
+	Method Create:TReleaseStmt( expr:TExpr )
+		Self.expr=expr
+		Return Self
+	End Method
+
+	Method OnCopy:TStmt( scope:TScopeDecl )
+		Return New TReleaseStmt.Create( expr.Copy() )
+	End Method
+	
+	Method OnSemant()
+		expr=expr.Semant()
+		If Not TVarExpr( expr ) And Not TMemberVarExpr( expr) And Not TIndexExpr( expr ) err "Expression must be a variable"
+		If Not TNumericType(expr.exprType) Err "Subexpression for release must be an integer variable"
+	End Method
+	
+	Method Trans$()
+		Return _trans.TransReleaseStmt( Self )
+	End Method
+End Type

+ 1 - 1
toker.bmx

@@ -53,7 +53,7 @@ Type TToker
 	"and;or;shl;shr;sar;end;if;then;else;elseif;endif;while;wend;repeat;until;forever;"+ ..
 	"for;to;step;next;return;"+ ..
 	"alias;rem;endrem;throw;assert;try;catch;nodebug;incbin;"+ ..
-	"endselect;endmethod;endfunction;endtype;endextern;endtry;pi;"
+	"endselect;endmethod;endfunction;endtype;endextern;endtry;pi;release;"
 
 	Global _symbols$[]=[ "..","[]",":*",":/",":+",":-",":|",":&",":~~",":shr",":shl",":sar",":mod" ]
 	Global _symbols_map$[]=[ "..","[]","*=","/=","+=","-=","|=","&=","^=",">>=", "<<=",">>=","%=" ]

+ 6 - 0
type.bmx

@@ -568,6 +568,12 @@ Type TStringType Extends TType
 	Method OnCopy:TType()
 		Local ty:TStringType = New TStringType
 		ty.cdecl = cdecl
+		If _flags & T_CHAR_PTR Then
+			ty._flags :| T_CHAR_PTR
+		End If
+		If _flags & T_SHORT_PTR Then
+			ty._flags :| T_SHORT_PTR
+		End If
 		Return ty
 	End Method