Merge master

bcc.bmx

@@ -1,4 +1,4 @@
-' Copyright (c) 2013-2023 Bruce A Henderson
+' Copyright (c) 2013-2024 Bruce A Henderson
 '
 ' Based on the public domain Monkey "trans" by Mark Sibly
 '

config.bmx

@@ -1,4 +1,4 @@
-' Copyright (c) 2013-2023 Bruce A Henderson
+' Copyright (c) 2013-2024 Bruce A Henderson
 '
 ' Based on the public domain Monkey "trans" by Mark Sibly
 '
@@ -26,7 +26,6 @@ SuperStrict
 Import BRL.LinkedList
 Import BRL.Map
 Import BRL.FileSystem
-Import Pub.zlib
 Import BRL.Math
 
 Import "options.bmx"
@@ -35,6 +34,7 @@ Import "base64.bmx"
 Import "enums.c"
 Import "hash.c"
 Import "math.c"
+Import "zlib/zlib.bmx"
 
 ' debugging help
 Const DEBUG:Int = False
@@ -623,15 +623,13 @@ Type TTemplateRecord
 ?Not bmxng
 		Local slen:Int = strlen_(s)
 ?bmxng
-		Local slen:UInt = strlen_(s)
+		Local slen:ULongInt = strlen_(s)
 ?
 
 ?Not bmxng		
 		Local dlen:Int = slen + 12
-?bmxng And (win32 Or ptr32)
-		Local dlen:UInt = slen + 12
-?bmxng And ptr64 And Not win32
-		Local dlen:ULong = slen + 12
+?bmxng
+		Local dlen:ULongInt = slen + 12
 ?
 		Local data:Byte[dlen]
 
@@ -651,18 +649,16 @@ Type TTemplateRecord
 
 ?Not bmxng		
 		Local dlen:Int = size + 1
-?bmxng And (win32 Or ptr32)
-		Local dlen:UInt = size + 1
-?bmxng And ptr64 And Not win32
-		Local dlen:ULong = size + 1
+?bmxng
+		Local dlen:ULongInt = size + 1
 ?
 		Local data:Byte[dlen]
 
 		Local s:Byte[] = TBase64.Decode(source)
 ?Not bmxng
 		uncompress(data, dlen, s, s.length)
 ?bmxng
-		uncompress(data, dlen, s, UInt(s.length))
+		uncompress(data, dlen, s, ULongInt(s.length))
 ?	
 		Return New TTemplateRecord.Create(start, file, String.FromUTF8String(data))
 	End Function

ctranslator.bmx

@@ -597,7 +597,7 @@ Type TCTranslator Extends TTranslator
 					End If
 				End If
 			End If
-			If TFunctionPtrType( ty) Return "(&brl_blitz_NullFunctionError)" ' todo ??
+			If TFunctionPtrType( ty) Return Bra(TransType(ty, "")) + "(&brl_blitz_NullFunctionError)"
 			If TEnumType( ty ) Then
 				If TEnumType( ty ).decl.isFlags Then
 					Return "0"
@@ -609,14 +609,18 @@ Type TCTranslator Extends TTranslator
 		InternalErr "TCTranslator.TransValue"
 	End Method
 
-	Method TransArgs$( args:TExpr[],decl:TFuncDecl, objParam:String = Null )
+	Method TransArgs$( args:TExpr[],decl:TFuncDecl, objParam:String = Null, objectNew:Int = False )
 'If decl.ident="AddS" DebugStop
 
 		Local t$
 		If objParam And (decl.IsMethod() Or decl.isCtor()) And ((Not decl.IsExtern()) Or (decl.IsExtern() And TClassDecl(decl.scope) And Not TClassDecl(decl.scope).IsStruct())) Then
 			' object cast to match param type
-			If TClassDecl(decl.scope) Then
-				t :+ Bra(TransObject(TClassDecl(decl.scope).GetLatestFuncDecl(decl).scope, TClassDecl(decl.scope).IsStruct()))
+			If objectNew Then
+				t :+ Bra("BBClass *")
+			Else
+				If TClassDecl(decl.scope) Then
+					t :+ Bra(TransObject(TClassDecl(decl.scope).GetLatestFuncDecl(decl).scope, TClassDecl(decl.scope).IsStruct()))
+				End If
 			End If
 			t:+ objParam
 		End If
@@ -629,7 +633,7 @@ Type TCTranslator Extends TTranslator
 				Local arg:TExpr = args[i]
 
 				' object cast to match param type
-				If TObjectType(ty) And Not TObjectType(ty).classDecl.IsStruct() Then
+				If TObjectType(ty) And Not TObjectType(ty).classDecl.IsStruct() And Not argDecl.castTo Then
 					Local fdecl:TFuncDecl = decl
 					If TClassDecl(decl.scope) Then
 						fdecl = TClassDecl(decl.scope).GetOriginalFuncDecl(decl)
@@ -707,6 +711,12 @@ Type TCTranslator Extends TTranslator
 						Continue
 					End If
 
+					If TCastExpr(arg) And TVarExpr(TCastExpr(arg).expr) Then
+						t:+ varRef
+						t:+ TransCast(TFunctionPtrType(ty)) + Bra(arg.Trans())
+						Continue
+					End If
+
 					' Object -> Byte Ptr
 					If IsPointerType(ty, TType.T_BYTE) And TObjectType(arg.exprType) Then
 						t:+ varRef + Bra("bbObjectToFieldOffset" + Bra("(BBObject*)" + arg.Trans()))
@@ -781,6 +791,30 @@ t:+"NULLNULLNULL"
 		Return Bra(t)
 	End Method
 
+	' translate to C cast
+	Method TransCast:String(funcPtr:TFunctionPtrType)
+		If Not funcPtr Then
+			Return ""
+		End If
+
+		Local s:String = "("
+		s:+ TransType(funcPtr.func.retType, "")
+		s:+ "(*)("
+
+		For Local i:Int=0 Until funcPtr.func.argDecls.Length
+			If i Then
+				s:+ ","
+			End If
+
+			s:+ TransType(funcPtr.func.argDecls[i].ty, "")
+
+		Next
+
+		s:+ ")"
+		s:+ ")"
+		Return s
+	End Method
+
 	Method TransArgsTypes$( args:TExpr[],declArgTypes:TType[])
 		Local t$
 		For Local i:Int=0 Until args.Length
@@ -865,7 +899,7 @@ t:+"NULLNULLNULL"
 		Local initTrans:String
 		If outputInit Then
 			Local cast:String
-			If TObjectType(decl.ty) And Not TObjectType(decl.ty).classDecl.IsStruct() Then
+			If (TObjectType(decl.ty) And Not TObjectType(decl.ty).classDecl.IsStruct()) Or TFunctionPtrType(decl.ty) Then
 				cast = Bra(TransType(decl.ty, ""))
 			End If
 
@@ -1017,9 +1051,9 @@ t:+"NULLNULLNULL"
 				If gdecl.init Then
 					If TFunctionPtrType(gdecl.ty) Then
 						If TInvokeExpr(gdecl.init) And Not TInvokeExpr(gdecl.init).invokedWithBraces Then
-							glob :+ TInvokeExpr(gdecl.init).decl.munged
+							glob :+ TransCast(TFunctionPtrType(gdecl.ty)) + TInvokeExpr(gdecl.init).decl.munged
 						Else
-							glob :+ gdecl.init.Trans()
+							glob :+ TransCast(TFunctionPtrType(gdecl.ty)) + gdecl.init.Trans()
 						End If
 					Else If Not TConstExpr(gdecl.init) And Not (gdecl.attrs & DECL_INITONLY) Then
 						' for non const, we need to add an initialiser
@@ -1890,12 +1924,12 @@ t:+"NULLNULLNULL"
 				End If
 			Else
 				If ClassHasObjectField(expr.classDecl) And Not expr.classDecl.IsStruct() Then
-					t = "_" + ctorMunged + "_ObjectNew" + TransArgs( expr.args,expr.ctor, "&" + expr.classDecl.actual.munged )
+					t = "_" + ctorMunged + "_ObjectNew" + TransArgs( expr.args,expr.ctor, "&" + expr.classDecl.actual.munged, True )
 				Else
 					If expr.classDecl.IsStruct() Then
 						t = ctorMunged + "_ObjectNew" + TransArgs( expr.args,expr.ctor)
 					Else
-						t = "_" + ctorMunged + "_ObjectNew" + TransArgs( expr.args,expr.ctor, "&" + expr.classDecl.actual.munged)
+						t = "_" + ctorMunged + "_ObjectNew" + TransArgs( expr.args,expr.ctor, "&" + expr.classDecl.actual.munged, True)
 					End If
 				End If
 			End If
@@ -1909,10 +1943,7 @@ t:+"NULLNULLNULL"
 
 		If expr.expr.length = 1 Then
 			If TObjectType(expr.ty) And TObjectType(expr.ty).classdecl.IsStruct() And Not IsPointerType(expr.ty) Then
-				Return "bbArrayNew1DStruct" + Bra(TransArrayType(expr.ty) + ", " + expr.expr[0].Trans() + ", sizeof" + ..
-					Bra(TransObject(TObjectType(expr.ty).classdecl)) + ", _" + TObjectType(expr.ty).classdecl.munged + "_New")
-			Else If TEnumType(expr.ty) Then
-				Return "bbArrayNew1DEnum" + Bra(TransArrayType(expr.ty) + ", " + expr.expr[0].Trans() + ", " + TEnumType(expr.ty).decl.munged + "_BBEnum_impl")
+				Return "bbArrayNew1DStruct_" + TObjectType(expr.ty).classdecl.munged + Bra(expr.expr[0].Trans())
 			Else
 				Return "bbArrayNew1D" + Bra(TransArrayType(expr.ty) + ", " + expr.expr[0].Trans())
 			End If
@@ -2010,7 +2041,7 @@ t:+"NULLNULLNULL"
 
 			If TArrayType(src) Then
 				If TArrayType(src).isStatic Then
-					Return Bra("&" + Bra(t))
+					Return Bra(t)
 				Else
 					Return Bra(Bra(TransType(dst, "")) + "BBARRAYDATA(" + t + ",1)")
 				End If
@@ -2466,12 +2497,12 @@ t:+"NULLNULLNULL"
 					' if we are casting to Object[], don't actually cast.
 					Return Bra(t)
 				Else
-					Return "bbArrayCastFromObject" + Bra(t + "," + TransArrayType(TArrayType( dst ).elemType))
+					Return "bbArrayCastFromObject" + Bra("(BBOBJECT)" + t + "," + TransArrayType(TArrayType( dst ).elemType))
 				End If
 			End If
 
 			If TObjectType( src) And (TObjectType( src ).classDecl.ident = "___Array" Or TObjectType( src ).classDecl.ident = "Object") Then
-				Return "bbArrayCastFromObject" + Bra(t + "," + TransArrayType(TArrayType( dst ).elemType))
+				Return "bbArrayCastFromObject" + Bra("(BBOBJECT)" + t + "," + TransArrayType(TArrayType( dst ).elemType))
 			End If
 		Else If TObjectType( dst )
 			'If TArrayType( src ) Return Bra("(BBOBJECT)"+t)
@@ -2761,8 +2792,7 @@ t:+"NULLNULLNULL"
 		If TArrayType(expr.exprType) Then
 			Local ty:TType = TArrayType(expr.exprType).elemType
 			If TObjectType(ty) And TObjectType(ty).classDecl.IsStruct() Then
-				Return "bbArraySliceStruct" + Bra(TransArrayType(ty) + "," + t_expr + "," + t_args + ", sizeof" + ..
-						Bra(TransObject(TObjectType(ty).classdecl)) + ", _" + TObjectType(ty).classdecl.munged + "_New")
+				Return "bbArraySliceStruct_" + TObjectType(ty).classdecl.munged + Bra( t_expr + "," + t_args )
 			Else
 				Return "bbArraySlice" + Bra(TransArrayType(ty) + "," + t_expr + "," + t_args)
 			End If
@@ -3219,11 +3249,18 @@ t:+"NULLNULLNULL"
 				s :+ lhs+TransAssignOp( stmt.op )+cast+rhs
 			End If
 		Else If (TFunctionPtrType(stmt.lhs.exprType) <> Null Or IsPointerType(stmt.lhs.exprType, TType.T_BYTE)) And TInvokeExpr(stmt.rhs) And Not TInvokeExpr(stmt.rhs).invokedWithBraces Then
+
+			If Not cast And TFunctionPtrType(stmt.lhs.exprType) Then
+				Local fp:TFunctionPtrType = TFunctionPtrType(stmt.lhs.exprType)
+				If fp.func.cdets Then
+					cast = fp.func.cdets.TransCast()
+				End If
+			End If
 			rhs = TInvokeExpr(stmt.rhs).decl.munged
 			s :+ lhs+TransAssignOp( stmt.op )+cast+rhs
 		Else If TObjectType(stmt.lhs.exprType) And TObjectType(stmt.lhs.exprType).classDecl.IsStruct() And rhs = "&bbNullObject" Then
 			s :+ lhs+TransAssignOp( stmt.op )+cast+"{}"
-		Else 
+		Else
 			s :+ lhs+TransAssignOp( stmt.op )+cast+rhs
 		End If
 
@@ -4080,9 +4117,21 @@ End Rem
 		Emit "unsigned int instance_size;"
 		Emit "void      (*ctor)( BBOBJECT o );"
 		Emit "void      (*dtor)( BBOBJECT o );"
-		Emit "BBSTRING  (*ToString)( BBOBJECT x );"
-		Emit "int       (*Compare)( BBOBJECT x,BBOBJECT y );"
-		Emit "BBOBJECT  (*SendMessage)( BBOBJECT o,BBOBJECT m,BBOBJECT s );"
+		If classHierarchyGetFunction(classDecl, "ToString") Then
+			Emit "BBSTRING  (*ToString)( struct " + classidForFunction(classDecl, "ToString") + "_obj* x );"
+		Else
+			Emit "BBSTRING  (*ToString)( BBOBJECT x );"
+		End If
+		If classHierarchyGetFunction(classDecl, "Compare") Then
+			Emit "BBINT     (*Compare)( struct " + classidForFunction(classDecl, "Compare") + "_obj* x, BBOBJECT y );"
+		Else
+			Emit "int       (*Compare)( BBOBJECT x,BBOBJECT y );"
+		End If
+		If classHierarchyGetFunction(classDecl, "SendMessage") Then
+			Emit "BBOBJECT  (*SendMessage)( struct " + classidForFunction(classDecl, "SendMessage") + "_obj* x, BBOBJECT m, BBOBJECT s );"
+		Else
+			Emit "BBOBJECT  (*SendMessage)( BBOBJECT o,BBOBJECT m,BBOBJECT s );"
+		End If
 		Emit "BBINTERFACETABLE itable;"
 		Emit "void*     extra;"
 		Emit "unsigned int obj_size;"
@@ -4261,6 +4310,10 @@ End Rem
 
 		EmitClassGlobalsProto(classDecl);
 
+		' struct arrays
+		Emit "BBArray *bbArrayNew1DStruct_" + classDecl.munged + "(int length);"
+		Emit "BBArray *bbArraySliceStruct_" + classDecl.munged + "(BBArray *inarr, int beg, int end);"
+
 	End Method
 
 	Method classGetFunction:TDecl(classDecl:TClassDecl, func:String)
@@ -4790,6 +4843,11 @@ End Rem
 
 			reserved = ",New,Delete,ToString,Compare,SendMessage,_reserved1_,_reserved2_,_reserved3_,".ToLower()
 
+			If (classDecl.attrs & CLASS_STRUCT) Then
+				Emit "BBARRAYNEW1DSTRUCT_FUNC" + Bra(classid + "," + classid + ", _" + classid + "_New" + ", " + EnQuote("@" + classDecl.ident))
+				Emit "BBARRAYSLICESTRUCT_FUNC" + Bra(classid + "," + classid + ", _" + classid + "_New" + ", " + EnQuote("@" + classDecl.ident))
+			End If
+
 		End If
 
 		' cif defs
@@ -4887,6 +4945,8 @@ End Rem
 						For Local func:TFuncDecl = EachIn ifc.GetImplementedFuncs()
 
 							If func.IsMethod() Then
+
+								Local cast:String = Bra( func.munged + "_m" )
 
 								For Local f:TFuncDecl = EachIn fdecls
 
@@ -4901,7 +4961,7 @@ End Rem
 
 										If Not dups.ValueForKey(id) Then
 
-											Emit "_" + f.munged + ","
+											Emit cast + "_" + f.munged + ","
 
 											dups.Insert(id, "")
 										End If
@@ -4943,19 +5003,19 @@ End Rem
 			End If
 
 			If classHierarchyGetFunction(classDecl, "ToString") Then
-				Emit "(BBSTRING (*)(BBOBJECT))_" + classidForFunction(classDecl, "ToString") + "_ToString,"
+				Emit "_" + classidForFunction(classDecl, "ToString") + "_ToString,"
 			Else
 				Emit "bbObjectToString,"
 			End If
 
 			If classHierarchyGetFunction(classDecl, "Compare") Then
-				Emit "(int (*)(BBOBJECT, BBOBJECT))_" + classidForFunction(classDecl, "Compare") + "_Compare,"
+				Emit "_" + classidForFunction(classDecl, "Compare") + "_Compare,"
 			Else
 				Emit "bbObjectCompare,"
 			End If
 
 			If classHierarchyGetFunction(classDecl, "SendMessage") Then
-				Emit "(BBOBJECT (*)(BBOBJECT, BBOBJECT, BBOBJECT))_" + classidForFunction(classDecl, "SendMessage") + "_SendMessage,"
+				Emit "_" + classidForFunction(classDecl, "SendMessage") + "_SendMessage,"
 			Else
 				Emit "bbObjectSendMessage,"
 			End If

decl.bmx

@@ -1,4 +1,4 @@
-' Copyright (c) 2013-2023 Bruce A Henderson
+' Copyright (c) 2013-2024 Bruce A Henderson
 '
 ' Based on the public domain Monkey "trans" by Mark Sibly
 '
@@ -1930,6 +1930,7 @@ Type TFuncDecl Extends TBlockDecl
 
 	Field castTo:String
 	Field noCastGen:Int
+	Field cdets:TCastDets
 
 	Field maybeFunctionPtr:Int
 
@@ -4486,3 +4487,29 @@ Type TGenProcessor Abstract
 	End Method
 
 End Type
+
+Type TCastDets
+
+	Field name:String
+	Field retType:String
+	Field noGen:Int
+	Field args:String[0]
+	Field api:String
+
+	Method TransCast:String()
+		Local s:String = "(" + retType + " (*)"
+
+		s :+ "("
+		For Local i:Int = 0 Until args.length
+			s :+ args[i]
+			If i < args.length - 1 Then
+				s :+ ","
+			End If
+		Next
+		s :+ ")"
+
+		s :+ ")"
+		Return s
+	End Method
+
+End Type

expr.bmx

@@ -1,4 +1,4 @@
-' Copyright (c) 2013-2023 Bruce A Henderson
+' Copyright (c) 2013-2024 Bruce A Henderson
 '
 ' Based on the public domain Monkey "trans" by Mark Sibly
 '

iparser.bmx

@@ -1,4 +1,4 @@
-' Copyright (c) 2013-2023 Bruce A Henderson
+' Copyright (c) 2013-2024 Bruce A Henderson
 '
 ' Based on the public domain Monkey "trans" by Mark Sibly
 '