Browse Source

Reworked Null handling.
Added low-level debug checks.
Invocation changes for enumerators and methods.
Interface parsing fix for null object inits.

woollybah 11 years ago
parent
commit
8f15793d4c
7 changed files with 162 additions and 39 deletions
  1. 5 0
      config.bmx
  2. 83 29
      ctranslator.bmx
  3. 2 2
      decl.bmx
  4. 26 0
      expr.bmx
  5. 9 0
      iparser.bmx
  6. 7 7
      options.bmx
  7. 30 1
      parser.bmx

+ 5 - 0
config.bmx

@@ -29,6 +29,11 @@ Import BRL.FileSystem
 
 Import "options.bmx"
 
+
+' debugging help
+Const DEBUG:Int = False
+Const ABORT_ON_NULL:Int = True
+
 Global ENV_LANG$
 
 Global _errInfo$

+ 83 - 29
ctranslator.bmx

@@ -223,7 +223,7 @@ Type TCTranslator Extends TTranslator
 		EndIf
 		InternalErr
 	End Method
-
+	
 	Method TransArgs$( args:TExpr[],decl:TFuncDecl, objParam:String = Null )
 'If decl.ident="FromCString" DebugStop
 		Local t$
@@ -233,7 +233,10 @@ Type TCTranslator Extends TTranslator
 		For Local i:Int=0 Until decl.argDecls.Length
 			If t t:+","
 			If i < args.length
-				If TStringVarPtrType(TArgDecl(decl.argDecls[i].actual).ty) Then
+				If TNullExpr(args[i]) Then
+					t :+ TransValue(TArgDecl(decl.argDecls[i].actual).ty, Null)
+					Continue
+				Else If TStringVarPtrType(TArgDecl(decl.argDecls[i].actual).ty) Then
 					If TCastExpr(args[i]) And TStringType(TCastExpr(args[i]).expr.exprType) Then
 						t:+ "&"
 					End If
@@ -256,7 +259,8 @@ Type TCTranslator Extends TTranslator
 						Continue
 					End If
 
-					If TObjectType(args[i].exprType) And TObjectType(args[i].exprType).classDecl = TClassDecl.nullObjectClass Then
+					If TObjectType(args[i].exprType) 'And TObjectType(args[i].exprType).classDecl = TClassDecl.nullObjectClass Then
+					err "NULL"
 						t:+ "0"
 						Continue
 					End If
@@ -268,7 +272,8 @@ Type TCTranslator Extends TTranslator
 					End If
 
 				Else If TNumericType(TArgDecl(decl.argDecls[i].actual).ty)  Then
-					If TObjectType(args[i].exprType) And TObjectType(args[i].exprType).classDecl = TClassDecl.nullObjectClass Then
+					If TObjectType(args[i].exprType) 'And TObjectType(args[i].exprType).classDecl = TClassDecl.nullObjectClass Then
+					err "NULL"
 						t:+ "0"
 						Continue
 					End If
@@ -277,14 +282,21 @@ Type TCTranslator Extends TTranslator
 			Else
 				decl.argDecls[i].Semant()
 				' default values
-				If decl.argDecls[i].init Then
-					If TConstExpr(decl.argDecls[i].init) And TConstExpr(decl.argDecls[i].init).value = "bbNullObject" Then
-						If TStringType(decl.argDecls[i].ty) Then
-							t :+ "&bbEmptyString"
-						Else If TArrayType(decl.argDecls[i].ty) Then
-							t :+ "&bbEmptyArray"
+				Local init:TExpr = decl.argDecls[i].init
+				If init Then
+					If TConstExpr(init) Then
+						If TObjectType(TConstExpr(init).exprType) Then
+t:+"NULLNULLNULL"
+						' And TNullDecl(TObjectType(TConstExpr(init).exprType).classDecl)) Or (TConstExpr(init).value = "bbNullObject") Then
+							If TStringType(decl.argDecls[i].ty) Then
+								t :+ "&bbEmptyString"
+							Else If TArrayType(decl.argDecls[i].ty) Then
+								t :+ "&bbEmptyArray"
+							Else
+								t :+ "&bbNullObject"
+							End If
 						Else
-							t :+ "&bbNullObject"
+							t:+ decl.argDecls[i].init.Trans()
 						End If
 					Else
 						t:+ decl.argDecls[i].init.Trans()
@@ -309,29 +321,34 @@ Type TCTranslator Extends TTranslator
 'DebugStop
 		If TPointerType(ty) Then
 			' TODO : pointer stuff
+			If TNullType(src) Return TransValue(ty, Null)
 			Return expr
 		End If
-
+'If expr = "NULL" DebugStop
 '		If TIntType(ty) And TStringType(src) Then
 'DebugStop
 '			Return "bbObjectDowncast" + Bra(expr + ",&" + TStringType(src).cDecl.munged)
 '		End If
 
+		If TNullType(src)
+			Return TransValue(ty, Null)
+		End If
+
 		If TStringType(ty) And TObjectType(src) Then
 			If Not TStringType(ty).cDecl Then
 				ty.Semant()
 			End If
-			If TNullDecl(TObjectType(src).classDecl) Then
-				Return "&bbEmptyString"
-			End If
+			'If TNullDecl(TObjectType(src).classDecl) Then
+			'	Return "&bbEmptyString"
+			'End If
 			Return "bbObjectDowncast" + Bra(expr + ",&" + TStringType(ty).cDecl.munged)
 		End If
 
-		If TArrayType(ty) And TObjectType(src) Then
-			If TNullDecl(TObjectType(src).classDecl) Then
-				Return "&bbEmptyArray"
-			End If
-		End If
+		'If TArrayType(ty) And TObjectType(src) Then
+		'	If TNullDecl(TObjectType(src).classDecl) Then
+		'		Return "&bbEmptyArray"
+		'	End If
+		'End If
 
 		If TVarPtrType(src) And TNumericType(ty) Then
 			Return "*" + expr
@@ -363,7 +380,6 @@ Type TCTranslator Extends TTranslator
 
 		'upcast?
 		If src.GetClass().ExtendsClass( ty.GetClass() ) Return expr
-'DebugStop
 		If TObjectType(ty) Then
 			Return "bbObjectDowncast" + Bra(expr + ",&" + TObjectType(ty).classDecl.munged)
 		End If
@@ -478,7 +494,7 @@ Type TCTranslator Extends TTranslator
 	End Method
 
 	Method TransFunc$( decl:TFuncDecl,args:TExpr[],lhs:TExpr, sup:Int = False )
-'If decl.ident = "ToString" DebugStop
+'If decl.ident = "ParseModuleImport" DebugStop
 
 		' for calling the super class method instead
 		Local tSuper:String
@@ -530,10 +546,17 @@ Type TCTranslator Extends TTranslator
 					'Local class:String = TransFuncClass(cdecl)
 					Return class + "->" + TransFuncPrefix(cdecl, decl.ident) + decl.ident+TransArgs( args,decl, TransSubExpr( lhs ) )
 				Else If TInvokeExpr(lhs) Then
-					Local obj:String = Bra("struct " + decl.scope.munged + "_obj*")
-					Local class:String = Bra("(" + obj + TransSubExpr( lhs ) +")->clas" + tSuper)
+					' create a local variable of the inner invocation
+					Local lvar:String = CreateLocal(lhs)
+
+					Local obj:String = TransFuncObj(decl.scope)
+					Local class:String = Bra("(" + obj + lvar +")->clas" + tSuper)
+					Return class + "->" + TransFuncPrefix(decl.scope, decl.ident)+ decl.ident+TransArgs( args,decl, lvar )
+
+					'Local obj:String = Bra("struct " + decl.scope.munged + "_obj*")
+					'Local class:String = Bra("(" + obj + TransSubExpr( lhs ) +")->clas" + tSuper)
 					'Local class:String = Bra("&" + decl.scope.munged)
-					Return class + "->" + TransFuncPrefix(decl.scope, decl.ident) + decl.ident+TransArgs( args,decl, TransSubExpr( lhs ) )
+					'Return class + "->" + TransFuncPrefix(decl.scope, decl.ident) + decl.ident+TransArgs( args,decl, TransSubExpr( lhs ) )
 				Else If TInvokeMemberExpr(lhs)
 					' create a local variable of the inner invocation
 					Local lvar:String = CreateLocal(lhs)
@@ -963,6 +986,7 @@ Type TCTranslator Extends TTranslator
 			'If TArrayType( src ) Return Bra("(BBOBJECT)"+t)
 			'If TStringType( src ) Return Bra("(BBOBJECT)"+t)
 			'If TObjectType( src ) Return t
+			If TNullType( src ) Return "&bbNullObject"
 			Return "bbObjectDowncast" + Bra(t + ",&" + TObjectType( dst ).classDecl.munged)
 		EndIf
 
@@ -1015,12 +1039,16 @@ Type TCTranslator Extends TTranslator
 		If TBinaryCompareExpr(expr) Then
 			If TStringType(TBinaryCompareExpr(expr).ty) Then
 				If t_lhs="&bbNullObject" Then
+					err "NULL"
 					t_lhs = "&bbEmptyString"
 				End If
 				If t_rhs="&bbNullObject" Then
+					err "NULL"
 					t_rhs = "&bbEmptyString"
 				End If
-				Return "bbStringCompare" + Bra(t_lhs + ", " + t_rhs) + TransBinaryOp(expr.op, "") + "0"
+				If t_lhs <> "&bbEmptyString" And t_rhs <> "&bbEmptyString" Then
+					Return "bbStringCompare" + Bra(t_lhs + ", " + t_rhs) + TransBinaryOp(expr.op, "") + "0"
+				End If
 			End If
 			If TPointerType(TBinaryCompareExpr(expr).ty) Then
 				If t_lhs="&bbNullObject" Then
@@ -1032,9 +1060,11 @@ Type TCTranslator Extends TTranslator
 			End If
 			If TArrayType(TBinaryCompareExpr(expr).ty) Then
 				If t_lhs="&bbNullObject" Then
+					err "NULL"
 					t_lhs = "&bbEmptyArray"
 				End If
 				If t_rhs="&bbNullObject" Then
+					err "NULL"
 					t_rhs = "&bbEmptyArray"
 				End If
 			End If
@@ -1272,6 +1302,10 @@ Type TCTranslator Extends TTranslator
 			s :+ lhs+TransAssignOp( stmt.op )+rhs
 		End If
 
+		If DEBUG Then
+			DebugObject(stmt.lhs.exprType, lhs, Null, True)
+		End If
+
 		Return s
 	End Method
 
@@ -1597,6 +1631,14 @@ End Rem
 		End If
 
 		If Not proto Then
+
+			If DEBUG Then
+				For Local i:Int=0 Until decl.argDecls.Length
+					Local arg:TArgDecl=decl.argDecls[i]
+					DebugObject(arg.ty, arg.munged, id)
+				Next
+			End If
+
 			If decl.IsAbstract() Then
 				Emit "brl_blitz_NullMethodError();"
 			Else
@@ -2238,6 +2280,10 @@ End Rem
 			Return "$" + Enquote(expr.Eval())
 		EndIf
 
+		If TArrayType(expr.exprType) Then
+			Return Enquote("bbEmptyArray")
+		End If
+
 		If TFunctionPtrType(expr.exprType) Then
 			If TCastExpr(expr) Then
 				If TInvokeExpr(TCastExpr(expr).expr) Then
@@ -2248,10 +2294,18 @@ End Rem
 			InternalErr
 		End If
 
-		If TObjectType(expr.exprType) And TNullDecl(TObjectType(expr.exprType).classDecl) Then
-			Return Enquote("bbNullObject")
+		If TObjectType(expr.exprType) Then
+			If TCastExpr(expr) Then
+				If TNullExpr(TCastExpr(expr).expr) Then
+					Return Enquote("bbNullObject")
+				End If
+			End If
 		End If
 
+		'If TObjectType(expr.exprType) And TNullDecl(TObjectType(expr.exprType).classDecl) Then
+		'	Return Enquote("bbNullObject")
+		'End If
+
 	End Method
 
 	Method EmitIfcConstDecl(constDecl:TConstDecl)
@@ -2968,6 +3022,6 @@ End Rem
 		TransInterface(app)
 
 	End Method
-
+	
 End Type
 

+ 2 - 2
decl.bmx

@@ -1089,7 +1089,7 @@ Type TClassDecl Extends TScopeDecl
 
 	Field objectType:TObjectType '"canned" objectType
 
-	Global nullObjectClass:TClassDecl=New TNullDecl.Create( "{NULL}",Null,Null,Null,DECL_ABSTRACT|DECL_EXTERN )
+	'Global nullObjectClass:TClassDecl=New TNullDecl.Create( "{NULL}",Null,Null,Null,DECL_ABSTRACT|DECL_EXTERN )
 	
 	Method Create:TClassDecl( ident$,args:TClassDecl[],superTy:TIdentType,impls:TIdentType[],attrs:Int )
 		Self.ident=ident
@@ -1352,7 +1352,7 @@ End Rem
 	End Method
 	
 	Method ExtendsClass:Int( cdecl:TClassDecl )
-		If Self=nullObjectClass Return True
+		'If Self=nullObjectClass Return True
 		
 '		If cdecl.IsTemplateArg()
 '			cdecl=TType.objectType.FindClass()

+ 26 - 0
expr.bmx

@@ -287,6 +287,7 @@ Type TConstExpr Extends TExpr
 		Local expr:TExpr=Semant()
 		If expr.exprType.EqualsType( ty ) Return expr
 		If value = "bbNullObject" Then
+			Err "bbNullObject"
 			Return expr
 		End If
 		Return New TCastExpr.Create( ty,expr,castFlags ).Semant()
@@ -1927,3 +1928,28 @@ Type TScopeExpr Extends TExpr
 		Return scope
 	End Method
 End Type
+
+Type TNullExpr Extends TExpr
+
+	Method Create:TNullExpr(ty:TType)
+		exprType = ty
+		Return Self
+	End Method
+
+	Method Copy:TExpr()
+		Return New TNullExpr.Create(exprType)
+	End Method
+
+	Method Semant:TExpr()
+		Return Self
+	End Method
+
+	Method Trans$()
+		Return "NULL"
+	End Method
+
+	Method Eval$()
+		Return ""
+	End Method
+
+End Type

+ 9 - 0
iparser.bmx

@@ -651,6 +651,15 @@ Method ParseFuncDecl:TFuncDecl( toke$,attrs:Int )
 					Else
 						If Not TFunctionPtrType(ty) Then
 							init = ParseUnaryExpr()
+							If TArrayType(ty) Then
+								If TConstExpr(init) And TConstExpr(init).value="bbEmptyArray" Then
+									init = New TNullExpr.Create(TType.nullObjectType)
+								End If
+							Else If TObjectType(ty) Or TIdentType(ty) Then
+								If TConstExpr(init) And TConstExpr(init).value="bbNullObject" Then
+									init = New TNullExpr.Create(TType.nullObjectType)
+								End If
+							End If
 						Else
 							' munged reference to default function pointer
 							Local defaultFunc:String = ParseStringLit()

+ 7 - 7
options.bmx

@@ -1,26 +1,26 @@
-' Copyright (c) 2013-2014 Bruce A Henderson & Ronny Otto 
+' Copyright (c) 2013-2014 Bruce A Henderson
 '
 ' Based on the public domain Monkey "trans" by Mark Sibly
-' 
+'
 ' This software is provided 'as-is', without any express or implied
 ' warranty. In no event will the authors be held liable for any damages
 ' arising from the use of this software.
-' 
+'
 ' Permission is granted to anyone to use this software for any purpose,
 ' including commercial applications, and to alter it and redistribute it
 ' freely, subject to the following restrictions:
-' 
+'
 '    1. The origin of this software must not be misrepresented; you must not
 '    claim that you wrote the original software. If you use this software
 '    in a product, an acknowledgment in the product documentation would be
 '    appreciated but is not required.
-' 
+'
 '    2. Altered source versions must be plainly marked as such, and must not be
 '    misrepresented as being the original software.
-' 
+'
 '    3. This notice may not be removed or altered from any source
 '    distribution.
-' 
+'
 SuperStrict
 
 Import "base.configmap.bmx"

+ 30 - 1
parser.bmx

@@ -84,6 +84,14 @@ Type TForEachinStmt Extends TStmt
 			block.AddStmt whileStmt
 
 		Else If TObjectType( expr.exprType )
+			Local tmpDecl:TDeclStmt
+
+			If TInvokeExpr(expr) Or TInvokeMemberExpr(expr) Then
+				Local tmpVar:TLocalDecl=New TLocalDecl.Create( "",expr.exprType,expr )
+				tmpVar.Semant()
+				tmpDecl = New TDeclStmt.Create( tmpVar )
+				expr = New TVarExpr.Create( tmpVar )
+			End If
 
 			Local enumerInit:TExpr=New TFuncCallExpr.Create( New TIdentExpr.Create( "ObjectEnumerator",expr ) )
 			Local enumerTmp:TLocalDecl=New TLocalDecl.Create( "",Null,enumerInit )
@@ -92,7 +100,24 @@ Type TForEachinStmt Extends TStmt
 			Local nextObjExpr:TExpr=New TFuncCallExpr.Create( New TIdentExpr.Create( "NextObject",New TVarExpr.Create( enumerTmp ) ) )
 
 			If varlocal
+'				Local varTmp:TLocalDecl=New TLocalDecl.Create( varid,varty,nextObjExpr )
+'				block.stmts.AddFirst New TDeclStmt.Create( varTmp )
+
+				' local variable
 				Local varTmp:TLocalDecl=New TLocalDecl.Create( varid,varty,nextObjExpr )
+
+				' local var as expression
+				Local expr:TExpr=New TVarExpr.Create( varTmp )
+
+				' var = Null
+				expr=New TBinaryCompareExpr.Create( "=",expr, New TNullExpr.Create(TType.nullObjectType))
+
+				' then continue
+				Local thenBlock:TBlockDecl=New TBlockDecl.Create( block.scope )
+				Local elseBlock:TBlockDecl=New TBlockDecl.Create( block.scope )
+				thenBlock.AddStmt New TContinueStmt
+
+				block.stmts.AddFirst New TIfStmt.Create( expr,thenBlock,elseBlock )
 				block.stmts.AddFirst New TDeclStmt.Create( varTmp )
 			Else
 				block.stmts.AddFirst New TAssignStmt.Create( "=",New TIdentExpr.Create( varid ),nextObjExpr )
@@ -101,6 +126,9 @@ Type TForEachinStmt Extends TStmt
 			Local whileStmt:TWhileStmt=New TWhileStmt.Create( hasNextExpr,block )
 
 			block=New TBlockDecl.Create( block.scope )
+			If tmpDecl Then
+				block.AddStmt tmpDecl
+			End If
 			block.AddStmt New TDeclStmt.Create( enumerTmp )
 			block.AddStmt whileStmt
 
@@ -658,7 +686,8 @@ Type TParser
 			EndIf
 		Case "null"
 			NextToke
-			expr=New TConstExpr.Create( TType.nullObjectType,"" )
+			expr = New TNullExpr.Create(TType.nullObjectType)
+			'expr=New TConstExpr.Create( TType.nullObjectType,"" )
 		Case "true"
 			NextToke
 			expr=New TConstExpr.Create( TType.intType,"1" )