author | unc0rr |
Wed, 04 Apr 2012 18:00:46 +0400 | |
changeset 6855 | 807156c01475 |
parent 6854 | 873929cbd54b |
child 6856 | a5b0afb60862 |
hedgewars/pas2cSystem.pas | file | annotate | diff | comparison | revisions | |
tools/pas2c.hs | file | annotate | diff | comparison | revisions |
--- a/hedgewars/pas2cSystem.pas Wed Apr 04 15:05:14 2012 +0400 +++ b/hedgewars/pas2cSystem.pas Wed Apr 04 18:00:46 2012 +0400 @@ -14,6 +14,7 @@ GLInt = integer; GLUInt = integer; gl_unsigned_byte = integer; + Int = integer; pointer = pointer; PChar = pointer; @@ -46,7 +47,9 @@ var false, true: boolean; + write, writeLn, read, readLn: procedure; + StrLen, ord, Succ, Pred : function : integer; inc, dec, Low, High, Lo, Hi : function : integer; odd, even : function : boolean; @@ -60,19 +63,21 @@ trunc, round : function : integer; Abs, Sqr : function : integer; - StrPas, FormatDateTime, copy, delete, str, pos : function : shortstring; + StrPas, FormatDateTime, copy, delete, str, pos, trim : function : shortstring; - assign, rewrite, reset, flush, BlockWrite, close : procedure; + assign, rewrite, reset, flush, BlockWrite, BlockRead, close : procedure; IOResult : function : integer; exit, break, halt, continue : procedure; TextFile, file : Handle; FileMode : integer; - eof : function : boolean; + FileExists, DirectoryExists, eof : function : boolean; + ExtractFileName : function : string; + exitcode : integer; ParamCount : function : integer; ParamStr : function : string; - Sqrt, ArcTan2, pi, cos, sin : function : float; + sqrt, arctan2, pi, cos, sin, power : function : float; TypeInfo, GetEnumName : function : shortstring; @@ -91,13 +96,30 @@ glcolor4ub, gl_texture_wrap_s, gltexparameteri, gl_texture_wrap_t, gl_texture_min_filter, gl_linear, gl_texture_mag_filter, glgentextures, - gldeletetextures, glreadpixels : procedure; + gldeletetextures, glreadpixels, glclearcolor, + gl_line_strip, gldeleterenderbuffersext, + gldeleteframebuffersext, glext_loadextension, + gl_max_texture_size, glgetintegerv, gl_renderer, + glgetstring, gl_vendor, gl_version, glgenframebuffersext, + glbindframebufferext, glgenrenderbuffersext, + glbindrenderbufferext, glrenderbufferstorageext, + glframebufferrenderbufferext, glframebuffertexture2dext, + gl_framebuffer_ext, gl_depth_component, + gl_depth_attachment_ext, gl_renderbuffer_ext, gl_rgba8, + gl_color_attachment0_ext, gl_modelview, gl_blend, + gl_src_alpha, gl_one_minus_src_alpha, + gl_perspective_correction_hint, gl_fastest, + gl_dither, gl_vertex_array, gl_texture_coord_array, + glviewport, glloadidentity, glmatrixmode, glhint, + glblendfunc, glenableclientstate, gl_color_buffer_bit, + glclear : procedure; TThreadId : function : integer; BeginThread, ThreadSwitch : procedure; InterlockedIncrement, InterlockedDecrement : procedure; random : function : integer; + randomize : procedure; Assigned : function : boolean;
--- a/tools/pas2c.hs Wed Apr 04 15:05:14 2012 +0400 +++ b/tools/pas2c.hs Wed Apr 04 18:00:46 2012 +0400 @@ -251,32 +251,33 @@ resolveType (Set t) = liftM BTSet $ resolveType t -fromPointer :: BaseType -> State RenderState BaseType -fromPointer (BTPointerTo t) = f t +fromPointer :: String -> BaseType -> State RenderState BaseType +fromPointer s (BTPointerTo t) = f t where f (BTUnresolved s) = do v <- gets $ find (\(a, _) -> a == s) . currentScope if isJust v then f . snd . snd . fromJust $ v else - error $ "Unknown type " ++ show t + error $ "Unknown type " ++ show t ++ "\n" ++ s f t = return t -fromPointer t = do +fromPointer s t = do ns <- gets currentScope - error $ "Dereferencing from non-pointer type " ++ show t ++ "\n\n" ++ show (take 100 ns) + error $ "Dereferencing from non-pointer type " ++ show t ++ "\n" ++ s ++ "\n\n" ++ show (take 100 ns) tvar2C :: Bool -> TypeVarDeclaration -> State RenderState Doc tvar2C _ (FunctionDeclaration name returnType params Nothing) = do t <- type2C returnType + t'<- gets lastType p <- withState' id $ liftM hcat $ mapM (tvar2C False) params - n <- id2C IOInsert name + n <- id2C IOInsert $ setBaseType (BTFunction t') name return $ t <+> n <> parens p <> text ";" -tvar2C True (FunctionDeclaration (Identifier i _) returnType params (Just (tvars, phrase))) = do +tvar2C True (FunctionDeclaration name returnType params (Just (tvars, phrase))) = do t <- type2C returnType t'<- gets lastType - n <- id2C IOInsert (Identifier i (BTFunction t')) + n <- id2C IOInsert $ setBaseType (BTFunction t') name (p, ph) <- withState' (\st -> st{currentScope = (lastIdentifier st, (lastIdentifier st ++ "_result", t')) : currentScope st}) $ do p <- liftM hcat $ mapM (tvar2C False) params ph <- liftM2 ($+$) (typesAndVars2C False tvars) (phrase2C' phrase) @@ -455,6 +456,7 @@ ref2C r@(RecordField ref1 (ArrayElement exprs ref2)) = ref2C $ ArrayElement exprs (RecordField ref1 ref2) ref2C r@(RecordField ref1 (Dereference ref2)) = ref2C $ Dereference (RecordField ref1 ref2) ref2C r@(RecordField ref1 (RecordField ref2 ref3)) = ref2C $ RecordField (RecordField ref1 ref2) ref3 +ref2C r@(RecordField ref1 (FunCall params ref2)) = ref2C $ FunCall params (RecordField ref1 ref2) -- conversion routines ref2C ae@(ArrayElement exprs ref) = do es <- mapM expr2C exprs @@ -473,7 +475,7 @@ ref2C (SimpleReference name) = id2C IOLookup name ref2C rf@(RecordField (Dereference ref1) ref2) = do r1 <- ref2C ref1 - t <- fromPointer =<< gets lastType + t <- fromPointer (show ref1) =<< gets lastType ns <- gets currentScope r2 <- case t of BTRecord rs -> withRecordNamespace rs $ ref2C ref2 @@ -491,9 +493,9 @@ a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf ++ "\n" ++ show (take 100 ns) return $ r1 <> text "." <> r2 -ref2C (Dereference ref) = do +ref2C d@(Dereference ref) = do r <- ref2C ref - t <- fromPointer =<< gets lastType + t <- fromPointer (show d) =<< gets lastType modify (\st -> st{lastType = t}) return $ (parens $ text "*") <> r ref2C (FunCall params ref) = do