From 3ab0248cbab1ac74c8ce5f01fc41d673d6f9f27b Mon Sep 17 00:00:00 2001 From: Tom Smeding Date: Mon, 14 Dec 2020 22:15:21 +0100 Subject: Lift out of prehistoric times --- .gitignore | 5 +---- LibLang.hs | 9 +++++++++ Main.hs | 59 ++++++++++++++++++++++++++++++++++++++--------------------- Makefile | 29 ----------------------------- langhs.cabal | 47 +++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 95 insertions(+), 54 deletions(-) create mode 100644 LibLang.hs delete mode 100644 Makefile create mode 100644 langhs.cabal diff --git a/.gitignore b/.gitignore index d197ab1..ac6e9bc 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,2 @@ -main -obj -obsolete z_output* -liblang.o +dist-newstyle/ diff --git a/LibLang.hs b/LibLang.hs new file mode 100644 index 0000000..3ca54ed --- /dev/null +++ b/LibLang.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TemplateHaskell #-} +module LibLang where + +import Data.ByteString (ByteString) +import Data.FileEmbed + + +libLangSource :: ByteString +libLangSource = $(embedFile "liblang.asm") diff --git a/Main.hs b/Main.hs index dc76f65..3e2a325 100644 --- a/Main.hs +++ b/Main.hs @@ -2,16 +2,19 @@ module Main where import Control.Exception (bracket) import Control.Monad +import qualified Data.ByteString as BS import System.Directory (removeFile) import System.Environment import System.Exit import System.IO import System.Process import qualified System.Posix.Temp as Posix +import qualified System.Info as System import BuildIR import CodeGen import Defs +import LibLang import Optimiser import OptionParser import Pretty @@ -51,6 +54,9 @@ mkTempFile = do hClose handle return path +withTempFile :: (FilePath -> IO a) -> IO a +withTempFile = bracket mkTempFile removeFile + main :: IO () main = do opts <- getArgs >>= eitherToIO . optionParser @@ -103,27 +109,38 @@ main = do exitSuccess - let objfnameIO = case laststage of - StageObject -> return outname - StageExecutable -> mkTempFile + let withObjfile = case laststage of + StageObject -> ($ outname) + StageExecutable -> withTempFile _ -> undefined - let rmObjfileIO = case outname of - "-" -> const $ return () - _ -> removeFile - - bracket objfnameIO rmObjfileIO $ \objfname -> do + let yasmFormat = case System.os of + "linux" -> "elf64" + "darwin" -> "macho64" + os -> error $ "Your OS (" ++ os ++ ") is unknown, can't create binary" + + let yasmToFile outfname writer = do + let yasmprocspec = + (proc "yasm" ["-w+all", "-f" ++ yasmFormat, "-", "-o", outfname]) + {std_in = CreatePipe} + yasmcode <- withCreateProcess yasmprocspec $ \(Just pipe) _ _ ph -> do + _ <- writer pipe + hFlush pipe + hClose pipe + waitForProcess ph + case yasmcode of + ExitSuccess -> return () + ExitFailure _ -> die "yasm failed!" + + withObjfile $ \objfname -> do hPutStrLn stderr "Assembling with yasm..." - let yasmprocspec = (proc "yasm" ["-w+all", "-fmacho64", "-", "-o", objfname]) {std_in = CreatePipe} - yasmcode <- withCreateProcess yasmprocspec $ \(Just pipe) _ _ ph -> do - hPutStr pipe asm - hFlush pipe - hClose pipe - waitForProcess ph - case yasmcode of - ExitSuccess -> return () - ExitFailure _ -> die "yasm failed!" - when (laststage == StageObject) exitSuccess - - hPutStrLn stderr "Linking with ld..." - callProcess "ld" [objfname, "liblang.o", "-o", outname] + yasmToFile objfname (\pipe -> hPutStr pipe asm) + + case laststage of + StageObject -> return () + StageExecutable -> + withTempFile $ \liblangfname -> do + yasmToFile liblangfname (\pipe -> BS.hPut pipe libLangSource) + hPutStrLn stderr "Linking with ld..." + callProcess "ld" [objfname, liblangfname, "-o", outname] + _ -> undefined diff --git a/Makefile b/Makefile deleted file mode 100644 index 5602120..0000000 --- a/Makefile +++ /dev/null @@ -1,29 +0,0 @@ -RUNFLAGS = -GHCFLAGS = -Wall -Widentities -Wno-unused-imports -odir obj -hidir obj -j4 -ifneq ($(PROFILE),) - RUNFLAGS += +RTS -xc - GHCFLAGS += -prof -fprof-auto -else - GHCFLAGS += -O3 -endif - -TARGET = main - -.PHONY: all clean run - -all: $(TARGET) liblang.o - -clean: - rm -f $(TARGET) - rm -rf obj - -run: $(TARGET) - ./$(TARGET) $(RUNFLAGS) - - -$(TARGET): $(wildcard *.hs) - @mkdir -p obj - ghc $(GHCFLAGS) Main.hs -o $@ - -liblang.o: liblang.asm - yasm -w+all -fmacho64 $< -o $@ diff --git a/langhs.cabal b/langhs.cabal new file mode 100644 index 0000000..73ac567 --- /dev/null +++ b/langhs.cabal @@ -0,0 +1,47 @@ +cabal-version: >=1.10 +name: langhs +synopsis: Compiler for a made-up language to x64 +version: 0.1.0.0 +license: MIT +author: Tom Smeding +maintainer: tom@tomsmeding.com +build-type: Simple + +executable langhs + main-is: Main.hs + other-modules: + AST + BuildIR + CodeGen + Defs + Intermediate + LibLang + -- LifetimeAnalysis2 + LifetimeAnalysis + LifetimeAnalysisOld + Optimiser + OptionParser + Pretty + ProgramParser + RegAlloc + ReplaceRefs + TypeCheck + TypeRules + Utils + Verify + X64 + X64Optimiser + build-depends: base >= 4.13 && < 4.15, + parsec >= 3.1 && < 3.2, + mtl >= 2.2 && < 2.3, + containers >= 0.6 && < 0.7, + directory >= 1.3 && < 1.4, + process >= 1.6 && < 1.7, + unix >= 2.7 && < 2.8, + bytestring, + -- vector >= 0.12 && < 0.13, + -- primitive >= 0.7 && < 0.8, + file-embed >= 0.0.13 && < 0.0.14 + hs-source-dirs: . + default-language: Haskell2010 + ghc-options: -Wall -O2 -threaded -Widentities -Wno-unused-imports -- cgit v1.2.3