Macintosh-Tools/Retro68
1
0
Fork 0
mirror of https://github.com/autc04/Retro68.git synced 2025-02-26 13:29:28 +00:00
Code Issues Projects Releases Wiki Activity

update to work with Universal Interfaces 3.4

Browse Source
This commit is contained in:
Wolfgang Thaller 2014-09-17 02:10:04 +02:00
parent e5e8352a32
commit ff0586d7f7
4 changed files with 65 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored Normal file
View File

@ -0,0 +1,2 @@
CIncludes
Universal Headers

72
PrepareHeaders.hs
View File

@ -35,9 +35,12 @@ import Control.Monad.State
import qualified Data.Map as Map import qualified Data.Map as Map
import System.Environment(getArgs) import System.Environment(getArgs)
data CallingConvention = Pascal | CCall
deriving(Show, Eq)
data Item = CharItem Char data Item = CharItem Char
| IgnoredItem | IgnoredItem
| FunctionItem String String [String] [String] [Integer] (Maybe ParameterRegs) | FunctionItem CallingConvention String String [String] [String] [Integer] (Maybe ParameterRegs)
| PragmaParameterItem String ParameterRegs | PragmaParameterItem String ParameterRegs
deriving(Show) deriving(Show)
@ -58,6 +61,8 @@ balancedText stopAtComma = fmap (foldr ($) "") $
many (fmap (++) paranthesized <|> fmap (:) (noneOf (if stopAtComma then "()," else "()"))) many (fmap (++) paranthesized <|> fmap (:) (noneOf (if stopAtComma then "()," else "()")))
where paranthesized = char '(' >> balancedText False >>= \xs -> char ')' >> return ('(' : xs ++ ")") where paranthesized = char '(' >> balancedText False >>= \xs -> char ')' >> return ('(' : xs ++ ")")
isIDChar '_' = True
isIDChar c = isAlphaNum c
trim = dropWhile isSpace . reverse . dropWhile isSpace . reverse trim = dropWhile isSpace . reverse . dropWhile isSpace . reverse
cleanup = unwords . words . trim cleanup = unwords . words . trim
@ -68,8 +73,10 @@ returnType = do
return $ t ++ ptrs return $ t ++ ptrs
externApiDeclaration = do externApiDeclaration = do
rettype <- (reserved tp "EXTERN_API" >> (fmap trim $ parens tp (balancedText False))) (cconv, rettype) <-
<|> (reserved tp "pascal" >> returnType) (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 name <- identifier tp
arguments <- fmap (map cleanup) $ parens tp (commaSep tp $ balancedText True) arguments <- fmap (map cleanup) $ parens tp (commaSep tp $ balancedText True)
@ -87,9 +94,9 @@ externApiDeclaration = do
semi tp semi tp
let arguments' | arguments == ["void"] = [] let arguments' | arguments == ["void"] = []
| otherwise = arguments | otherwise = arguments
argumentNames = map (trim . reverse . takeWhile isAlphaNum . reverse . trim) arguments' argumentNames = map (trim . reverse . takeWhile isIDChar . reverse . trim) arguments'
argumentTypes = map (trim . reverse . dropWhile isAlphaNum . reverse . trim) arguments' argumentTypes = map (trim . reverse . dropWhile isIDChar . reverse . trim) arguments'
return $ FunctionItem rettype name argumentTypes argumentNames inlines Nothing return $ FunctionItem cconv rettype name argumentTypes argumentNames inlines Nothing
pragmaParameter = do pragmaParameter = do
reservedOp tp "#" reservedOp tp "#"
@ -114,6 +121,8 @@ data TypeCategory = ByteType | WordType | LongType | PointerType | VoidType
classifyType tm t | "Ptr" `isSuffixOf` t = Just PointerType classifyType tm t | "Ptr" `isSuffixOf` t = Just PointerType
| "*" `isSuffixOf` t = Just PointerType | "*" `isSuffixOf` t = Just PointerType
| "Handle" `isSuffixOf` t = Just PointerType | "Handle" `isSuffixOf` t = Just PointerType
| "UPP" `isSuffixOf` t = Just PointerType
| "Ref" `isSuffixOf` t = Just PointerType
classifyType tm "unsigned char" = Just ByteType classifyType tm "unsigned char" = Just ByteType
classifyType tm "signed char" = Just ByteType classifyType tm "signed char" = Just ByteType
classifyType tm "char" = Just ByteType classifyType tm "char" = Just ByteType
@ -124,9 +133,9 @@ classifyType tm t = Map.lookup t tm
hexword = integer tp hexword = integer tp
outputItem typeMap (CharItem c) = [c] outputItem typeMap (CharItem c) = [c]
-- outputItem (FunctionItem rettype name argumentTypes argumentNames words) = "<fun>" -- outputItem (FunctionItem cconv rettype name argumentTypes argumentNames words) = "<fun>"
outputItem typeMap (FunctionItem rettype name argumentTypes argumentNames words Nothing) outputItem typeMap (FunctionItem cconv rettype name argumentTypes argumentNames words Nothing)
| True, not (null words), Just retcat <- classifyType typeMap rettype | True, not (null words), Just retcat <- classifyType typeMap rettype
= let = let
helper = PP.text "__magic_inline_" <> PP.text name helper = PP.text "__magic_inline_" <> PP.text name
@ -143,12 +152,16 @@ outputItem typeMap (FunctionItem rettype name argumentTypes argumentNames words
_ -> reverse $ "0" : argumentNames _ -> reverse $ "0" : argumentNames
words' = case retcat of words' = case retcat of
VoidType -> words VoidType -> words
_ | cconv == CCall -> words
ByteType -> words ++ [ 0x101f ] -- move.b (a7)+,d0 ByteType -> words ++ [ 0x101f ] -- move.b (a7)+,d0
WordType -> words ++ [ 0x301f ] -- move.w (a7)+,d0 WordType -> words ++ [ 0x301f ] -- move.w (a7)+,d0
LongType -> words ++ [ 0x201f ] -- move.l (a7)+,d0 LongType -> words ++ [ 0x201f ] -- move.l (a7)+,d0
PointerType -> words ++ [ 0x201f ] -- move.l (a7)+,d0 PointerType -> words ++ [ 0x201f ] -- move.l (a7)+,d0
cconvAttr = case cconv of
Pascal -> PP.text "__attribute__((stdcall))"
CCall -> PP.empty
in PP.render $ in PP.render $
PP.text rettype <+> PP.text "__attribute__((stdcall))" <+> helper PP.text rettype <+> cconvAttr <+> helper
<> PP.parens (PP.hsep $ PP.punctuate PP.comma $ map PP.text magicArgTypes) <> PP.parens (PP.hsep $ PP.punctuate PP.comma $ map PP.text magicArgTypes)
<+> PP.text("__asm__") <> PP.parens ( PP.doubleQuotes magic ) <+> PP.text("__asm__") <> PP.parens ( PP.doubleQuotes magic )
<> PP.semi <> PP.semi
@ -163,7 +176,7 @@ outputItem typeMap (FunctionItem rettype name argumentTypes argumentNames words
outputItem typeMap (FunctionItem rettype name argumentTypes argumentNames words mbParamRegs) = outputItem typeMap (FunctionItem cconv rettype name argumentTypes argumentNames words mbParamRegs) =
PP.render $ PP.render $
linkage <+> PP.text rettype <+> PP.text name linkage <+> PP.text rettype <+> PP.text name
<+> PP.parens (PP.hsep $ PP.punctuate PP.comma $ zipWith (\t n -> PP.text t <+> PP.text n) argumentTypes argumentNames) $$ <+> PP.parens (PP.hsep $ PP.punctuate PP.comma $ zipWith (\t n -> PP.text t <+> PP.text n) argumentTypes argumentNames) $$
@ -264,9 +277,9 @@ outputItem _ _ = ""
collectPragmas xs = evalState (mapM doit xs) Map.empty collectPragmas xs = evalState (mapM doit xs) Map.empty
where where
doit x@(PragmaParameterItem name params) = modify (Map.insert name params) >> return x doit x@(PragmaParameterItem name params) = modify (Map.insert name params) >> return x
doit (FunctionItem rettype name argumentTypes argumentNames inlines _) = do doit (FunctionItem cconv rettype name argumentTypes argumentNames inlines _) = do
m <- get m <- get
return $ FunctionItem rettype name argumentTypes argumentNames inlines (Map.lookup name m) return $ FunctionItem cconv rettype name argumentTypes argumentNames inlines (Map.lookup name m)
doit x = return x doit x = return x
parseTypeMap tm = Map.fromList $ map handleLine $ lines tm parseTypeMap tm = Map.fromList $ map handleLine $ lines tm
@ -275,6 +288,7 @@ parseTypeMap tm = Map.fromList $ map handleLine $ lines tm
(x : xs) -> (trim $ unwords xs, case x of (x : xs) -> (trim $ unwords xs, case x of
"B" -> ByteType ; "W" -> WordType ; "L" -> LongType ; "P" -> PointerType) "B" -> ByteType ; "W" -> WordType ; "L" -> LongType ; "P" -> PointerType)
processFile inputDir outputDir file processFile inputDir outputDir file
| isLower (head file) = putStrLn $ "Skipping " ++ file ++ " (standard library or MPW runtime)"
| ".h" `isSuffixOf` file = do | ".h" `isSuffixOf` file = do
print $ (outputDir </> takeFileName file) print $ (outputDir </> takeFileName file)
-- readFile (inputDir </> file) -- readFile (inputDir </> file)
@ -287,16 +301,30 @@ processFile inputDir outputDir file
Right items -> do Right items -> do
outf <- openFile (outputDir </> file) WriteMode outf <- openFile (outputDir </> file) WriteMode
hSetEncoding outf latin1 hSetEncoding outf latin1
when (file == "ConditionalMacros.h") $ do
hPutStrLn outf $ unlines [ let processed = concatMap (outputItem typeMap) $ collectPragmas $ items
"#define TARGET_CPU_68K 1", if (file == "ConditionalMacros.h")
"#define TYPE_LONGLONG 1", then do
"#define pascal", hPutStrLn outf $ unlines [
"#ifdef __cplusplus", "#define TARGET_CPU_68K 1",
"#define TYPE_BOOL 1", "#define TARGET_OS_MAC 1",
"#endif" "#define TARGET_RT_MAC_CFM 0",
] "#define TARGET_RT_MAC_MACHO 0",
hPutStr outf $ concatMap (outputItem typeMap) $ collectPragmas $ items
"#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 hClose outf
Left err -> putStrLn $ file ++ ": " ++ show err Left err -> putStrLn $ file ++ ": " ++ show err
| otherwise = do | otherwise = do

10
README.md
View File

@ -24,6 +24,10 @@ For Ubuntu Linux, the following should help a bit:
sudo apt-get install cmake ghc libboost-dev libgmp-dev libmpfr-dev libmpc-dev sudo apt-get install cmake ghc libboost-dev libgmp-dev libmpfr-dev libmpc-dev
On a Mac, get the homebrew package manager and:
brew install cmake gmp mpfr libmpc
Apple Universal Interfaces Apple Universal Interfaces
-------------------------- --------------------------
@ -31,9 +35,7 @@ The Universal Interfaces used to be a free download from Apple. However,
they have taken the site offline and the license agreement prohibits they have taken the site offline and the license agreement prohibits
redistribution, so this might be a bit hard to find nowadays. redistribution, so this might be a bit hard to find nowadays.
You do need a version that still supports 68K Mac development, so You do need a version that still supports 68K Mac development.
version 3.4 will NOT work. Basically, look for something no later than 1999
or so.
The package might be somewhere in this huge snapshot of Apple's FTP site made The package might be somewhere in this huge snapshot of Apple's FTP site made
by the Internet Archive: by the Internet Archive:
@ -46,7 +48,7 @@ http://macintoshgarden.org/apps/macintosh-programmer%E2%80%99s-workshop
and use the CIncludes directory from there. and use the CIncludes directory from there.
Put the C header files into a directory called "Universal Headers" at the top Put the C header files into a directory called "CIncludes" at the top
level of the Retro68 directory. level of the Retro68 directory.
Building Building

8
build-toolchain.sh
View File

@ -59,7 +59,13 @@ make
make install make install
cd .. cd ..
runhaskell ../Retro68/PrepareHeaders.hs ../Retro68/Universal\ Headers toolchain/m68k-unknown-elf/include for headerdir in "Universal\ Headers" "CIncludes"; do
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