mirror of
https://github.com/autc04/Retro68.git
synced 2024-12-22 04:30:03 +00:00
PrepareHeaders.hs is no longer needed.
Instead, there is prepare-headers.sh which only needs to patch ConditionalMacros.h
This commit is contained in:
Wolfgang Thaller
parent
05f4c57615
commit
4d936a889c
@ -1,208 +0,0 @@
|
|||||||
-- Copyright 2012 Wolfgang Thaller.
|
|
||||||
--
|
|
||||||
-- This file is part of Retro68.
|
|
||||||
--
|
|
||||||
-- Retro68 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 3 of the License, or
|
|
||||||
-- (at your option) any later version.
|
|
||||||
--
|
|
||||||
-- Retro68 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 Retro68. If not, see <http://www.gnu.org/licenses/>.
|
|
||||||
|
|
||||||
module Main where
|
|
||||||
|
|
||||||
import Text.ParserCombinators.Parsec
|
|
||||||
import Text.ParserCombinators.Parsec.Language
|
|
||||||
import Text.ParserCombinators.Parsec.Token
|
|
||||||
import System.Directory
|
|
||||||
import System.FilePath
|
|
||||||
import Control.Monad(guard)
|
|
||||||
import Data.List(isSuffixOf)
|
|
||||||
import qualified Control.Exception
|
|
||||||
import System.IO
|
|
||||||
import qualified Text.PrettyPrint.HughesPJ as PP
|
|
||||||
import Text.PrettyPrint.HughesPJ((<+>),(<>),($$),($+$))
|
|
||||||
import Data.Char
|
|
||||||
import Numeric
|
|
||||||
import Data.Maybe(isJust)
|
|
||||||
import Control.Monad.State
|
|
||||||
import qualified Data.Map as Map
|
|
||||||
import System.Environment(getArgs)
|
|
||||||
|
|
||||||
data CallingConvention = Pascal | CCall
|
|
||||||
deriving(Show, Eq)
|
|
||||||
|
|
||||||
data Item = CharItem Char
|
|
||||||
| IgnoredItem
|
|
||||||
| FunctionItem CallingConvention String String [String] [String] [Integer] (Maybe ParameterRegs)
|
|
||||||
| PragmaParameterItem String ParameterRegs
|
|
||||||
deriving(Show)
|
|
||||||
|
|
||||||
type Register = String
|
|
||||||
data ParameterRegs = ParameterRegs (Maybe Register) [Register]
|
|
||||||
deriving(Show)
|
|
||||||
|
|
||||||
tp = makeTokenParser javaStyle
|
|
||||||
|
|
||||||
item = (char '\r' >> return (CharItem '\n'))
|
|
||||||
<|> try externApiDeclaration
|
|
||||||
-- <|> try (string "= 0x4E90" >> return IgnoredItem)
|
|
||||||
-- <|> try (string "= 0x4E91" >> return IgnoredItem)
|
|
||||||
<|> try pragmaParameter
|
|
||||||
<|> fmap CharItem anyChar
|
|
||||||
|
|
||||||
balancedText stopAtComma = fmap (foldr ($) "") $
|
|
||||||
many (fmap (++) paranthesized <|> fmap (:) (noneOf (if stopAtComma then "()," else "()")))
|
|
||||||
where paranthesized = char '(' >> balancedText False >>= \xs -> char ')' >> return ('(' : xs ++ ")")
|
|
||||||
|
|
||||||
isIDChar '_' = True
|
|
||||||
isIDChar c = isAlphaNum c
|
|
||||||
|
|
||||||
trim = dropWhile isSpace . reverse . dropWhile isSpace . reverse
|
|
||||||
cleanup = unwords . words . trim
|
|
||||||
|
|
||||||
returnType = do
|
|
||||||
t <- identifier tp
|
|
||||||
ptrs <- many (reservedOp tp "*" >> return '*')
|
|
||||||
return $ t ++ ptrs
|
|
||||||
|
|
||||||
externApiDeclaration = do
|
|
||||||
(cconv, rettype) <-
|
|
||||||
(reserved tp "EXTERN_API" >> (fmap ((,) Pascal) $ fmap trim $ parens tp (balancedText False)))
|
|
||||||
<|> (reserved tp "EXTERN_API_C" >> (fmap ((,) CCall) $ fmap trim $ parens tp (balancedText False)))
|
|
||||||
<|> (reserved tp "pascal" >> fmap ((,) Pascal) returnType)
|
|
||||||
name <- identifier tp
|
|
||||||
arguments <- fmap (map cleanup) $ parens tp (commaSep tp $ balancedText True)
|
|
||||||
|
|
||||||
let hexwords = commaSep tp hexword
|
|
||||||
macroinline = do
|
|
||||||
inlinekey <- identifier tp
|
|
||||||
guard ("WORDINLINE" `isSuffixOf` inlinekey)
|
|
||||||
parens tp hexwords
|
|
||||||
plaininline = do
|
|
||||||
reservedOp tp "="
|
|
||||||
braces tp hexwords
|
|
||||||
|
|
||||||
inlines <- macroinline <|> plaininline <|> return []
|
|
||||||
|
|
||||||
semi tp
|
|
||||||
let arguments' | arguments == ["void"] = []
|
|
||||||
| otherwise = arguments
|
|
||||||
argumentNames = map (trim . reverse . takeWhile isIDChar . reverse . trim) arguments'
|
|
||||||
argumentTypes = map (trim . reverse . dropWhile isIDChar . reverse . trim) arguments'
|
|
||||||
return $ FunctionItem cconv rettype name argumentTypes argumentNames inlines Nothing
|
|
||||||
|
|
||||||
pragmaParameter = do
|
|
||||||
reservedOp tp "#"
|
|
||||||
reserved tp "pragma"
|
|
||||||
reserved tp "parameter"
|
|
||||||
retval <- optionMaybe reg
|
|
||||||
name <- identifier tp
|
|
||||||
args <- parens tp (commaSep tp reg)
|
|
||||||
-- args <- option [] $ parens tp (fmap return $ reg)
|
|
||||||
-- let args = []
|
|
||||||
return $ PragmaParameterItem name (ParameterRegs retval args)
|
|
||||||
|
|
||||||
reg = (reserved tp "__A0" >> return "%%a0")
|
|
||||||
<|>(reserved tp "__A1" >> return "%%a1")
|
|
||||||
<|>(reserved tp "__A2" >> return "%%a2")
|
|
||||||
<|>(reserved tp "__D0" >> return "%%d0")
|
|
||||||
<|>(reserved tp "__D1" >> return "%%d1")
|
|
||||||
|
|
||||||
|
|
||||||
pprParameterRegs (ParameterRegs mbRet args)
|
|
||||||
= maybe PP.empty PP.text mbRet
|
|
||||||
<+> PP.parens (
|
|
||||||
PP.hsep $ PP.punctuate PP.comma $ map PP.text args
|
|
||||||
)
|
|
||||||
|
|
||||||
hexword = integer tp
|
|
||||||
outputItem (CharItem c) = [c]
|
|
||||||
-- outputItem (FunctionItem cconv rettype name argumentTypes argumentNames words) = "<fun>"
|
|
||||||
|
|
||||||
outputItem (FunctionItem cconv rettype name argumentTypes argumentNames words mbParamRegs)
|
|
||||||
= let
|
|
||||||
magic = PP.text "__magic_inline_" <> PP.hcat (PP.punctuate (PP.char '_') (map (PP.text . hexword) words))
|
|
||||||
hexword w = replicate (4 - length s) '0' ++ s where s = showHex w ""
|
|
||||||
cconvAttr = case (mbParamRegs,cconv) of
|
|
||||||
(Just regs, _) -> PP.text "__attribute__((__regparam__(" <> PP.doubleQuotes regstr <> PP.text ")))"
|
|
||||||
where regstr = pprParameterRegs regs
|
|
||||||
(Nothing, Pascal) | not (null words) -> PP.text "__attribute__((__pascal__))"
|
|
||||||
(Nothing, _) -> PP.empty
|
|
||||||
|
|
||||||
isInline = not (null words)
|
|
||||||
|
|
||||||
magicAttr | isInline = PP.text "__attribute__((__magicinline__))"
|
|
||||||
| otherwise = PP.empty
|
|
||||||
inlineMagic | isInline = PP.text("__asm__") <> PP.parens ( PP.doubleQuotes magic )
|
|
||||||
| otherwise = PP.empty
|
|
||||||
in PP.render $
|
|
||||||
PP.text rettype <+> cconvAttr <+> magicAttr <+> PP.text name
|
|
||||||
<> PP.parens (PP.hsep $ PP.punctuate PP.comma $ zipWith (\t n -> PP.text t <+> PP.text n) argumentTypes argumentNames)
|
|
||||||
<+> inlineMagic
|
|
||||||
<> PP.semi <> PP.text "\n"
|
|
||||||
|
|
||||||
outputItem _ = ""
|
|
||||||
|
|
||||||
collectPragmas xs = evalState (mapM doit xs) Map.empty
|
|
||||||
where
|
|
||||||
doit x@(PragmaParameterItem name params) = modify (Map.insert name params) >> return x
|
|
||||||
doit (FunctionItem cconv rettype name argumentTypes argumentNames inlines _) = do
|
|
||||||
m <- get
|
|
||||||
return $ FunctionItem cconv rettype name argumentTypes argumentNames inlines (Map.lookup name m)
|
|
||||||
doit x = return x
|
|
||||||
|
|
||||||
processFile inputDir outputDir file
|
|
||||||
| isLower (head file) = putStrLn $ "Skipping " ++ file ++ " (standard library or MPW runtime)"
|
|
||||||
| ".h" `isSuffixOf` file = do
|
|
||||||
print $ (outputDir </> takeFileName file)
|
|
||||||
-- readFile (inputDir </> file)
|
|
||||||
f <- openFile (inputDir </> file) ReadMode
|
|
||||||
hSetEncoding f latin1
|
|
||||||
txt <- hGetContents f
|
|
||||||
let parseResult = parse (many item) file txt
|
|
||||||
case parseResult of
|
|
||||||
Right items -> do
|
|
||||||
outf <- openFile (outputDir </> file) WriteMode
|
|
||||||
hSetEncoding outf latin1
|
|
||||||
|
|
||||||
let processed = concatMap outputItem $ collectPragmas $ items
|
|
||||||
if (file == "ConditionalMacros.h")
|
|
||||||
then do
|
|
||||||
hPutStrLn outf $ unlines [
|
|
||||||
"#define TARGET_CPU_68K 1",
|
|
||||||
"#define TARGET_OS_MAC 1",
|
|
||||||
"#define TARGET_RT_MAC_CFM 0",
|
|
||||||
"#define TARGET_RT_MAC_MACHO 0",
|
|
||||||
|
|
||||||
"#define TYPE_LONGLONG 1",
|
|
||||||
"#define pascal",
|
|
||||||
"#ifdef __cplusplus",
|
|
||||||
"#define TYPE_BOOL 1",
|
|
||||||
"#endif"
|
|
||||||
]
|
|
||||||
|
|
||||||
hPutStr outf $ unlines $
|
|
||||||
map (\line -> if line == "#elif defined(__GNUC__)"
|
|
||||||
then "#elif 0"
|
|
||||||
else line) $
|
|
||||||
lines $ processed
|
|
||||||
else
|
|
||||||
hPutStr outf $ processed
|
|
||||||
hClose outf
|
|
||||||
Left err -> putStrLn $ file ++ ": " ++ show err
|
|
||||||
| otherwise = do
|
|
||||||
putStrLn $ "Unknown: " ++ file
|
|
||||||
|
|
||||||
main = do
|
|
||||||
[inputDir,outputDir] <- getArgs
|
|
||||||
files <- getDirectoryContents inputDir
|
|
||||||
Control.Exception.try (createDirectory outputDir) :: IO (Either Control.Exception.IOException ())
|
|
||||||
mapM (processFile inputDir outputDir) files
|
|
||||||
return ()
|
|
||||||
@ -59,13 +59,7 @@ make
|
|||||||
make install
|
make install
|
||||||
cd ..
|
cd ..
|
||||||
|
|
||||||
for headerdir in "Universal\ Headers" "CIncludes"; do
|
sh "$SRC/prepare-headers.sh" "$SRC/CIncludes" toolchain/m68k-unknown-elf/include
|
||||||
if test -d "../Retro68/$headerdir"; then
|
|
||||||
HEADERDIR="../Retro68/$headerdir"
|
|
||||||
fi
|
|
||||||
done
|
|
||||||
|
|
||||||
runhaskell ../Retro68/PrepareHeaders.hs "$HEADERDIR" toolchain/m68k-unknown-elf/include
|
|
||||||
|
|
||||||
mkdir -p build-host
|
mkdir -p build-host
|
||||||
cd build-host
|
cd build-host
|
||||||
|
|||||||
58
prepare-headers.sh
Normal file
58
prepare-headers.sh
Normal file
@ -0,0 +1,58 @@
|
|||||||
|
IN=$1
|
||||||
|
OUT=$2
|
||||||
|
|
||||||
|
# cp $IN/[A-Z]*.h $OUT/
|
||||||
|
for file in $(cd $IN; ls [A-Z]*.h); do
|
||||||
|
tr '\r' '\n' < $IN/$file > $OUT/$file
|
||||||
|
done
|
||||||
|
|
||||||
|
cat > $OUT/ConditionalMacros.h <<END_MARKER
|
||||||
|
|
||||||
|
#ifndef __CONDITIONALMACROS__WRAP__
|
||||||
|
#define __CONDITIONALMACROS__WRAP__
|
||||||
|
|
||||||
|
#define TARGET_CPU_68K 1
|
||||||
|
#define TARGET_OS_MAC 1
|
||||||
|
#define TARGET_RT_MAC_CFM 0
|
||||||
|
#define TARGET_RT_MAC_MACHO 0
|
||||||
|
#define TYPE_LONGLONG 1
|
||||||
|
#define pascal __attribute__((__pascal__))
|
||||||
|
#define FUNCTION_PASCAL 1
|
||||||
|
#ifdef __cplusplus
|
||||||
|
#define TYPE_BOOL 1
|
||||||
|
#endif
|
||||||
|
END_MARKER
|
||||||
|
|
||||||
|
tr '\r' '\n' < $IN/ConditionalMacros.h | sed 's/__GNUC__/__GNUC_DISABLED__/g' >> $OUT/ConditionalMacros.h
|
||||||
|
|
||||||
|
cat >> $OUT/ConditionalMacros.h <<END_MARKER
|
||||||
|
|
||||||
|
#undef ONEWORDINLINE(w1)
|
||||||
|
#undef TWOWORDINLINE(w1,w2)
|
||||||
|
#undef THREEWORDINLINE(w1,w2,w3)
|
||||||
|
#undef FOURWORDINLINE(w1,w2,w3,w4)
|
||||||
|
#undef FIVEWORDINLINE(w1,w2,w3,w4,w5)
|
||||||
|
#undef SIXWORDINLINE(w1,w2,w3,w4,w5,w6)
|
||||||
|
#undef SEVENWORDINLINE(w1,w2,w3,w4,w5,w6,w7)
|
||||||
|
#undef EIGHTWORDINLINE(w1,w2,w3,w4,w5,w6,w7,w8)
|
||||||
|
#undef NINEWORDINLINE(w1,w2,w3,w4,w5,w6,w7,w8,w9)
|
||||||
|
#undef TENWORDINLINE(w1,w2,w3,w4,w5,w6,w7,w8,w9,w10)
|
||||||
|
#undef ELEVENWORDINLINE(w1,w2,w3,w4,w5,w6,w7,w8,w9,w10,w11)
|
||||||
|
#undef TWELVEWORDINLINE(w1,w2,w3,w4,w5,w6,w7,w8,w9,w10,w11,w12)
|
||||||
|
|
||||||
|
#define ONEWORDINLINE(w1) __attribute__((__raw_inline__(w1)))
|
||||||
|
#define TWOWORDINLINE(w1,w2) __attribute__((__raw_inline__(w1,w2)))
|
||||||
|
#define THREEWORDINLINE(w1,w2,w3) __attribute__((__raw_inline__(w1,w2,w3)))
|
||||||
|
#define FOURWORDINLINE(w1,w2,w3,w4) __attribute__((__raw_inline__(w1,w2,w3,w4)))
|
||||||
|
#define FIVEWORDINLINE(w1,w2,w3,w4,w5) __attribute__((__raw_inline__(w1,w2,w3,w4,w5)))
|
||||||
|
#define SIXWORDINLINE(w1,w2,w3,w4,w5,w6) __attribute__((__raw_inline__(w1,w2,w3,w4,w5,w6)))
|
||||||
|
#define SEVENWORDINLINE(w1,w2,w3,w4,w5,w6,w7) __attribute__((__raw_inline__(w1,w2,w3,w4,w5,w6,w7)))
|
||||||
|
#define EIGHTWORDINLINE(w1,w2,w3,w4,w5,w6,w7,w8) __attribute__((__raw_inline__(w1,w2,w3,w4,w5,w6,w7,w8)))
|
||||||
|
#define NINEWORDINLINE(w1,w2,w3,w4,w5,w6,w7,w8,w9) __attribute__((__raw_inline__(w1,w2,w3,w4,w5,w6,w7,w8,w9)))
|
||||||
|
#define TENWORDINLINE(w1,w2,w3,w4,w5,w6,w7,w8,w9,w10) __attribute__((__raw_inline__(w1,w2,w3,w4,w5,w6,w7,w8,w9,w10)))
|
||||||
|
#define ELEVENWORDINLINE(w1,w2,w3,w4,w5,w6,w7,w8,w9,w10,w11) __attribute__((__raw_inline__(w1,w2,w3,w4,w5,w6,w7,w8,w9,w10,w11)))
|
||||||
|
#define TWELVEWORDINLINE(w1,w2,w3,w4,w5,w6,w7,w8,w9,w10,w11,w12) __attribute__((__raw_inline__(w1,w2,w3,w4,w5,w6,w7,w8,w9,w10,w11,w12)))
|
||||||
|
|
||||||
|
#endif /* __CONDITIONALMACROS__WRAP__ */
|
||||||
|
END_MARKER
|
||||||
|
|
||||||
Loading…
Reference in New Issue
Block a user