callGCC
This commit is contained in:
22
app/Main.hs
22
app/Main.hs
@@ -1,5 +1,6 @@
|
|||||||
{-# LANGUAGE OverloadedLabels #-}
|
{-# LANGUAGE OverloadedLabels #-}
|
||||||
{-# LANGUAGE OverloadedLists #-}
|
{-# LANGUAGE OverloadedLists #-}
|
||||||
|
{-# LANGUAGE ViewPatterns #-}
|
||||||
module Main
|
module Main
|
||||||
(main)
|
(main)
|
||||||
where
|
where
|
||||||
@@ -15,7 +16,7 @@ import Options.Applicative
|
|||||||
import Control.Lens
|
import Control.Lens
|
||||||
import Data.Generics.Labels
|
import Data.Generics.Labels
|
||||||
import System.OsPath (OsPath)
|
import System.OsPath (OsPath)
|
||||||
import System.FilePath ((-<.>))
|
import System.FilePath ((-<.>), dropExtension)
|
||||||
import Effectful.FileSystem
|
import Effectful.FileSystem
|
||||||
import Effectful
|
import Effectful
|
||||||
import Effectful.FileSystem.IO qualified as FS
|
import Effectful.FileSystem.IO qualified as FS
|
||||||
@@ -88,13 +89,29 @@ callQBE
|
|||||||
callQBE f = do
|
callQBE f = do
|
||||||
let asm_file = f -<.> "s"
|
let asm_file = f -<.> "s"
|
||||||
qbe_file = f -<.> "ssa"
|
qbe_file = f -<.> "ssa"
|
||||||
C.StdoutTrimmed stdout <-
|
C.StdoutUntrimmed stdout <-
|
||||||
C.run $ C.cmd "qbe" & C.addArgs [qbe_file]
|
C.run $ C.cmd "qbe" & C.addArgs [qbe_file]
|
||||||
FS.withFile asm_file FS.WriteMode \h -> do
|
FS.withFile asm_file FS.WriteMode \h -> do
|
||||||
hPutStr h stdout
|
hPutStr h stdout
|
||||||
hPutStrLn FS.stderr $ "wrote " <> T.pack asm_file
|
hPutStrLn FS.stderr $ "wrote " <> T.pack asm_file
|
||||||
pure asm_file
|
pure asm_file
|
||||||
|
|
||||||
|
callGCC
|
||||||
|
:: (GenSym :> es, FileSystem :> es, IOE :> es)
|
||||||
|
=> FilePath -> List String -> Eff es FilePath
|
||||||
|
callGCC f args = do
|
||||||
|
let asm_file = f -<.> "s"
|
||||||
|
exe = dropExtension f
|
||||||
|
C.StdoutTrimmed (T.words -> flags) <-
|
||||||
|
C.run $ C.cmd "pkg-config"
|
||||||
|
& C.addArgs @String ["--cflags", "--libs", "bdw-gc"]
|
||||||
|
C.run_ $ C.cmd "cc"
|
||||||
|
& C.addArgs flags
|
||||||
|
& C.addArgs ["-o", exe, asm_file]
|
||||||
|
& C.addArgs args
|
||||||
|
hPutStrLn FS.stderr $ "wrote " <> T.pack exe
|
||||||
|
pure exe
|
||||||
|
|
||||||
driver
|
driver
|
||||||
:: (GenSym :> es, FileSystem :> es, IOE :> es)
|
:: (GenSym :> es, FileSystem :> es, IOE :> es)
|
||||||
=> Options -> Eff es ()
|
=> Options -> Eff es ()
|
||||||
@@ -103,4 +120,5 @@ driver = runGenSym . traverseOf_ (#sourceFiles . folded) \f -> do
|
|||||||
anfs <- toANF f exps
|
anfs <- toANF f exps
|
||||||
qbe <- toQBE f anfs
|
qbe <- toQBE f anfs
|
||||||
callQBE f
|
callQBE f
|
||||||
|
callGCC f ["../runtime/gyehoek.c"]
|
||||||
pure ()
|
pure ()
|
||||||
|
|||||||
@@ -1,4 +1,4 @@
|
|||||||
;;; -*- mode:scheme -*-
|
;;; -*- mode:scheme -*-
|
||||||
|
|
||||||
(let ((x0 (prim:write 4))) x0)
|
(let ((x0 (prim:+ 2 4)) (x1 (prim:write x0))) x1)
|
||||||
|
|
||||||
|
|||||||
2
play/t.s
2
play/t.s
@@ -3,7 +3,7 @@
|
|||||||
main:
|
main:
|
||||||
pushq %rbp
|
pushq %rbp
|
||||||
movq %rsp, %rbp
|
movq %rsp, %rbp
|
||||||
movl $18, %edi
|
movl $30, %edi
|
||||||
callq scm_write
|
callq scm_write
|
||||||
leave
|
leave
|
||||||
ret
|
ret
|
||||||
|
|||||||
@@ -1 +1 @@
|
|||||||
(prim:write 4)
|
(prim:write (prim:+ 2 4))
|
||||||
|
|||||||
@@ -1,6 +1,9 @@
|
|||||||
export
|
export
|
||||||
function w $main () {
|
function w $main () {
|
||||||
@start
|
@start
|
||||||
%x0 =l call $scm_write (l 18)
|
%.2 =l add 10, 18
|
||||||
ret %x0
|
%.3 =l and %.2, 18446744073709551613
|
||||||
|
%x0 =l or %.3, 2
|
||||||
|
%x1 =l call $scm_write (l %x0)
|
||||||
|
ret %x1
|
||||||
}
|
}
|
||||||
Reference in New Issue
Block a user