diff options
-rw-r--r-- | BuildIR.hs | 30 | ||||
-rw-r--r-- | CodeGen.hs | 10 | ||||
-rw-r--r-- | Main.hs | 2 | ||||
-rw-r--r-- | X64.hs | 29 | ||||
-rw-r--r-- | X64Optimiser.hs | 63 | ||||
-rw-r--r-- | liblang.asm | 154 |
6 files changed, 245 insertions, 43 deletions
@@ -338,20 +338,20 @@ convertExpression (ESubscript arr sub t) nextnext = do subref <- convertExpression sub bl3 switchBlock bl3 offref <- genTemp (refSize subref) - off8ref <- genTemp (refSize subref) elemptr <- genTemp (refSize arrref) + arrszptr <- genTemp (sizeof TInt) arrsz <- genTemp (sizeof TInt) errbl <- gets errorBlock - addIns $ ILoad arrsz arrref + addIns $ IAri ASub arrszptr arrref (Constant (refSize arrref) (fromIntegral $ sizeof TInt)) + addIns $ ILoad arrsz arrszptr bl4 <- newBlockNoSwitch setTerm $ IJcc CUGeq subref arrsz errbl bl4 switchBlock bl4 addIns $ IAri AMul offref subref (Constant (refSize subref) (fromIntegral elemsz)) - addIns $ IAri AAdd off8ref offref (Constant (refSize subref) (fromIntegral $ sizeof TInt)) - addIns $ IAri AAdd elemptr arrref off8ref + addIns $ IAri AAdd elemptr arrref offref ref <- genTemp elemsz addIns $ ILoad ref elemptr setTerm $ IJmp nextnext @@ -375,13 +375,15 @@ convertExpression (ENew t sze) nextnext = do bl2 <- newBlockNoSwitch szref <- convertExpression sze bl2 switchBlock bl2 + ref' <- genTemp (sizeof $ TArr t Nothing) ref <- genTemp (sizeof $ TArr t Nothing) argref' <- genTemp (sizeof TInt) argref <- genTemp (sizeof TInt) addIns $ IAri AMul argref' szref (Constant (sizeof TInt) (fromIntegral $ sizeof t)) addIns $ IAri AAdd argref argref' (Constant (sizeof TInt) (fromIntegral $ sizeof TInt)) - addIns $ ICallr ref "_builtin_malloc" [argref] - addIns $ IStore ref szref + addIns $ ICallr ref' "_builtin_malloc" [argref] + addIns $ IStore ref' szref + addIns $ IAri AAdd ref ref' (Constant (refSize ref') (fromIntegral $ sizeof TInt)) setTerm $ IJmp nextnext return ref @@ -400,20 +402,20 @@ convertAsExpression (AESubscript ae2 expr mrt) valueref nextnext = do bl2 <- newBlockNoSwitch subref <- convertExpression expr bl2 switchBlock bl2 - offref' <- genTemp (sizeof TInt) offref <- genTemp (sizeof TInt) elemptr <- genTemp (sizeof TInt) + arrszptr <- genTemp (sizeof TInt) arrsz <- genTemp (sizeof TInt) errbl <- gets errorBlock - addIns $ ILoad arrsz ae2ref + addIns $ IAri ASub arrszptr ae2ref (Constant (refSize ae2ref) (fromIntegral $ sizeof TInt)) + addIns $ ILoad arrsz arrszptr bl3 <- newBlockNoSwitch setTerm $ IJcc CUGeq subref arrsz errbl bl3 switchBlock bl3 - addIns $ IAri AMul offref' subref (Constant (sizeof TInt) (fromIntegral elemsz)) - addIns $ IAri AAdd offref offref' (Constant (sizeof TInt) (fromIntegral $ sizeof TInt)) + addIns $ IAri AMul offref subref (Constant (refSize subref) (fromIntegral elemsz)) addIns $ IAri AAdd elemptr ae2ref offref addIns $ IStore elemptr valueref setTerm $ IJmp nextnext @@ -434,20 +436,20 @@ convertAsExpression (AESubscript ae2 expr mrt) valueref nextnext = do bl2 <- newBlockNoSwitch eref <- convertExpression expr' bl2 switchBlock bl2 - offref' <- genTemp (sizeof TInt) offref <- genTemp (sizeof TInt) elemptr <- genTemp (sizeof TInt) + arrszptr <- genTemp (sizeof TInt) arrsz <- genTemp (sizeof TInt) errbl <- gets errorBlock - addIns $ ILoad arrsz ref + addIns $ IAri ASub arrszptr ref (Constant (refSize ref) (fromIntegral $ sizeof TInt)) + addIns $ ILoad arrsz arrszptr bl3 <- newBlockNoSwitch setTerm $ IJcc CUGeq eref arrsz errbl bl3 switchBlock bl3 - addIns $ IAri AMul offref' eref (Constant (sizeof TInt) (fromIntegral elemsz)) - addIns $ IAri AAdd offref offref' (Constant (sizeof TInt) (fromIntegral $ sizeof TInt)) + addIns $ IAri AMul offref eref (Constant (sizeof TInt) (fromIntegral elemsz)) addIns $ IAri AAdd elemptr ref offref dstref <- genTemp elemsz addIns $ ILoad dstref elemptr @@ -64,6 +64,7 @@ codegen (IRProgram vars funcs) = do x64 <- execCGMonad $ mapM_ codegenFunc funcs -- traceShowM x64 X64.verify x64 + -- traceM $ X64.stringify x64 varcg <- liftM unlines $ mapM codegenVar vars x64opt <- x64Optimise x64 return $ "extern putc, putint, getc, exit, _builtin_malloc, _builtin_outofbounds\n" ++ @@ -109,6 +110,7 @@ codegenFunc (IRFunc _ name al bbs sid) = do traceM $ "ALLOCATION: " ++ show allocation let nsaves = length usedregs + alignoff = if odd nsaves then 8 else 0 allocationXref = flip Map.mapWithKey allocation $ \ref alloc -> case alloc of AllocReg reg -> XReg (fromIntegral $ refSize ref) reg AllocMem -> XMem (fromIntegral $ refSize ref) @@ -117,7 +119,8 @@ codegenFunc (IRFunc _ name al bbs sid) = do allocmap = foldl inserter allocationXref (zip al [0::Int ..]) where inserter m ((t, n), i) = - let offset = fromIntegral spillsz + 8 * nsaves + 8 {- rbp -} + 8 {- ret addr -} + 8 * i + let offset = fromIntegral spillsz + alignoff + 8 * nsaves + + 8 {- rbp -} + 8 {- ret addr -} + 8 * i in Map.insert (Argument (sizeof t) n) (XMem (fromIntegral $ sizeof t) (Just RSP) (0, RAX) Nothing @@ -128,6 +131,7 @@ codegenFunc (IRFunc _ name al bbs sid) = do addIns $ PUSH (xref $ XReg 8 RBP) addIns $ MOV (xref $ XReg 8 RBP) (xref $ XReg 8 RSP) forM_ usedregs $ \reg -> addIns $ PUSH (xref $ XReg 8 reg) + when (odd $ length usedregs) $ addIns $ SUB (xref $ XReg 8 RSP) (xref $ XImm 8) when (spillsz /= 0) $ addIns $ SUB (xref $ XReg 8 RSP) (xref $ XImm $ fromIntegral spillsz) setRegsToRestore usedregs setSpillSize spillsz @@ -291,6 +295,7 @@ codegenIns m (IAri at d s1 s2) = case arithTypeToCondCode at of s1m = mkxref s1 m s2m = mkxref s2 m codegenIns m (ICall n rs) = do + when (odd $ length rs) $ addIns $ SUB (xref $ XReg 8 RSP) (xref $ XImm 8) forM_ (zip (reverse rs) [1::Int ..]) $ \(r, i) -> let sz = fromIntegral $ refSize r src = (mkxref r m) @@ -304,6 +309,7 @@ codegenIns m (ICall n rs) = do when (length rs > 0) $ addIns $ SUB (xref $ XReg 8 RSP) (xref $ XImm (fromIntegral $ 8 * length rs)) addIns $ CALL n when (length rs > 0) $ addIns $ ADD (xref $ XReg 8 RSP) (xref $ XImm (fromIntegral $ 8 * length rs)) + when (odd $ length rs) $ addIns $ ADD (xref $ XReg 8 RSP) (xref $ XImm 8) codegenIns m (ICallr d n rs) = do codegenIns m (ICall n rs) addIns $ mkmov (mkxref d m) (XReg (fromIntegral $ refSize d) RAX) @@ -380,6 +386,7 @@ codegenTerm _ IRet = do spillsz <- gets spillSize when (spillsz /= 0) $ addIns $ ADD (xref $ XReg 8 RSP) (xref $ XImm $ fromIntegral spillsz) usedregs <- gets regsToRestore + when (odd $ length usedregs) $ addIns $ ADD (xref $ XReg 8 RSP) (xref $ XImm 8) forM_ (reverse usedregs) $ \reg -> addIns $ POP (xref $ XReg 8 reg) addIns $ mkmov (XReg 8 RSP) (XReg 8 RBP) addIns $ POP (xref $ XReg 8 RBP) @@ -389,6 +396,7 @@ codegenTerm m (IRetr r) = do spillsz <- gets spillSize when (spillsz /= 0) $ addIns $ ADD (xref $ XReg 8 RSP) (xref $ XImm $ fromIntegral spillsz) usedregs <- gets regsToRestore + when (odd $ length usedregs) $ addIns $ ADD (xref $ XReg 8 RSP) (xref $ XImm 8) forM_ (reverse usedregs) $ \reg -> addIns $ POP (xref $ XReg 8 reg) addIns $ mkmov (XReg 8 RSP) (XReg 8 RBP) addIns $ POP (xref $ XReg 8 RBP) @@ -8,7 +8,6 @@ import Debug.Trace import BuildIR import CodeGen import Defs -import InternStrings import Optimiser import Pretty import ProgramParser @@ -34,7 +33,6 @@ performCompile source = do let eres = return source >>= parseProgram <?> "Parse error" >>= typeCheck <?> "Type error" - -- >>= internStrings <?> "Error interning strings" >>= buildIR <?> "IR building error" >>= optimise <?> "Error while optimising" >>= return . traceShowId @@ -184,26 +184,31 @@ instance Stringifiable XRef where stringify (XMem _ _ (mult, _) _ _) | not (mult `elem` [0,1,2,4,8]) = error $ "Register multiplier has invalid value " ++ show mult ++ " in XMem" - stringify (XMem sz mr pair lab off) = - let res = intercalate "+" (catMaybes [goR1 mr, goPair pair, goLab lab]) ++ goOff off - in szword sz ++ " " ++ if null res then "[0]" else "[" ++ res ++ "]" + stringify x@(XMem sz _ _ _ _) = szword sz ++ " " ++ stringify_only_xmem_brackets x where szword 1 = "byte" szword 2 = "word" szword 4 = "dword" szword 8 = "qword" szword _ = undefined - goR1 Nothing = Nothing - goR1 (Just r) = Just $ stringify (XReg 8 r) - goPair (0, _) = Nothing - goPair (mult, r) = Just $ show mult ++ "*" ++ stringify (XReg 8 r) - goLab = id - goOff o | o > 0 = '+' : show o - | o < 0 = show o - | otherwise = "" stringify (XImm imm) = show imm +stringify_only_xmem_brackets :: XRef -> String +stringify_only_xmem_brackets (XMem _ mr pair lab off) = + let res = intercalate "+" (catMaybes [goR1 mr, goPair pair, goLab lab]) ++ goOff off + in if null res then "[0]" else "[" ++ res ++ "]" + where + goR1 Nothing = Nothing + goR1 (Just r) = Just $ stringify (XReg 8 r) + goPair (0, _) = Nothing + goPair (mult, r) = Just $ show mult ++ "*" ++ stringify (XReg 8 r) + goLab = id + goOff o | o > 0 = '+' : show o + | o < 0 = show o + | otherwise = "" +stringify_only_xmem_brackets _ = undefined + instance Stringifiable Reg where stringify (Reg x) = stringify x instance Stringifiable Mem where stringify (Mem x) = stringify x instance Stringifiable Imm where stringify (Imm x) = stringify x @@ -235,7 +240,7 @@ instance Stringifiable CondCode where instance Stringifiable Ins where stringify (MOV a b) = "mov " ++ stringify a ++ ", " ++ stringify b stringify (MOVi a b) = "mov " ++ stringify a ++ ", " ++ stringify b - stringify (LEA a b) = "lea " ++ stringify a ++ ", " ++ stringify b + stringify (LEA a (Mem b)) = "lea " ++ stringify a ++ ", " ++ stringify_only_xmem_brackets b stringify (MOVSX a b@(RegMem bx)) = case compare (xrefGetSize bx) 4 of EQ -> "movsxd " ++ stringify a ++ ", " ++ stringify b LT -> "movsx " ++ stringify a ++ ", " ++ stringify b diff --git a/X64Optimiser.hs b/X64Optimiser.hs index fa5d113..195389f 100644 --- a/X64Optimiser.hs +++ b/X64Optimiser.hs @@ -1,6 +1,7 @@ module X64Optimiser(x64Optimise) where import Data.List +import Data.Maybe import Defs import X64 @@ -9,7 +10,10 @@ import X64 x64Optimise :: Asm -> Error Asm x64Optimise asm = return $ - funcopt optCoalesceInstructions $ + funcopt optSimpleInstructions $ + funcopt optDoubleAdd $ + funcopt optMergeRSP $ + funcopt optMergeRSP $ -- #HACK (sometimes needed to eliminate all rsp arithmetic) optUnnecessaryJumps $ funcopt optSimpleInstructions $ asm @@ -35,10 +39,12 @@ optSimpleInstructions (name, inss) = (name, concat $ map goI inss) goI (MOVi (Reg (XReg 8 r)) (Imm (XImm 0))) = [XOR (RegMem (XReg 4 r)) (RegMemImm (XReg 4 r))] goI (MOVi (Reg a) (Imm (XImm 0))) = [XOR (RegMem a) (RegMemImm a)] goI (MOVSX (Reg a) (RegMem b)) | a == b = [] + goI (ADD _ (RegMemImm (XImm 0))) = [] + goI (SUB _ (RegMemImm (XImm 0))) = [] goI ins = [ins] -optCoalesceInstructions :: Func -> Func -optCoalesceInstructions (name, inss) = (name, go inss) +optMergeRSP :: Func -> Func +optMergeRSP (name, inss) = (name, go inss) where go :: [Ins] -> [Ins] go [] = [] @@ -76,3 +82,54 @@ optCoalesceInstructions (name, inss) = (name, go inss) XMem _ _ (_, RSP) _ _ -> Nothing x@(XReg _ _) -> Just x x@(XMem _ _ _ _ _) -> Just x + +optDoubleAdd :: Func -> Func +optDoubleAdd (name, inss) = (name, go inss) + where + go :: [Ins] -> [Ins] + go [] = [] + go (add@(ADD (RegMem xreg@(XReg _ xregReg)) (RegMemImm (XImm _))) : rest) = + let midx = flip findIndex rest $ \ins -> case ins of + ADD (RegMem xreg2@(XReg _ _)) (RegMemImm (XImm _)) | xreg == xreg2 -> True + SUB (RegMem xreg2@(XReg _ _)) (RegMemImm (XImm _)) | xreg == xreg2 -> True + _ -> False + in case midx of + Nothing -> add : go rest + Just idx -> if all (canSkip xregReg) (take idx rest) + then go $ merge add (rest !! idx) : take idx rest ++ drop (idx + 1) rest + else add : go rest + go (ins : rest) = ins : go rest + + canSkip :: Register -> Ins -> Bool + canSkip _ (CALL _) = False + canSkip _ (JMP _) = False + canSkip _ (JCC _ _) = False + canSkip _ RET = False + canSkip reg ins = + isJust $ xrefMapM (\y -> if y `containsReg` reg then Nothing else Just y) ins + + containsReg :: XRef -> Register -> Bool + containsReg (XReg _ r) reg | r == reg = True + containsReg (XMem _ (Just r) _ _ _) reg | r == reg = True + containsReg (XMem _ _ (s, r) _ _) reg | s /= 0 && r == reg = True + containsReg _ _ = False + + merge :: Ins -> Ins -> Ins + merge ins1 ins2 = + let e1 = effectOf ins1 + e2 = effectOf ins2 + dst1 = destOf ins1 + dst2 = destOf ins2 + in if dst1 == dst2 + then ADD (RegMem dst1) (RegMemImm $ XImm $ e1 + e2) + else undefined + + effectOf :: Ins -> Offset + effectOf (ADD _ (RegMemImm (XImm i))) = i + effectOf (SUB _ (RegMemImm (XImm i))) = -i + effectOf _ = undefined + + destOf :: Ins -> XRef + destOf (ADD (RegMem d) _) = d + destOf (SUB (RegMem d) _) = d + destOf _ = undefined diff --git a/liblang.asm b/liblang.asm index 3ae345d..9cd905c 100644 --- a/liblang.asm +++ b/liblang.asm @@ -1,16 +1,77 @@ -SYS_EXIT equ 0x2000001 ;code -SYS_FORK equ 0x2000002 ;-- -SYS_READ equ 0x2000003 ;fd, buf, len -SYS_WRITE equ 0x2000004 ;fd, buf, len -SYS_MMAP equ 0x20000C5 ;addr, len, prot, flags, fd, offset +; TAKEN FROM https://github.com/davidad/asm_concurrency/blob/master/os_dependent_stuff.asm +; syscalls +%ifidn __OUTPUT_FORMAT__,elf64 +; http://lxr.linux.no/linux+v3.13.5/arch/x86/syscalls/syscall_64.tbl + %define SYS_READ 0 + %define SYS_OPEN 2 + %define SYS_WRITE 1 + %define SYS_MMAP 9 + %define SYS_FTRUNCATE 77 + %define SYS_PWRITE 18 + %define SYS_FORK 57 + %define SYS_WAITID 247 + %define SYS_EXIT 60 +%elifidn __OUTPUT_FORMAT__,macho64 +; http://www.opensource.apple.com/source/xnu/xnu-1456.1.26/bsd/kern/syscalls.master + %define SYS_READ 0x2000003 + %define SYS_OPEN 0x2000005 + %define SYS_WRITE 0x2000004 + %define SYS_MMAP 0x20000C5 + %define SYS_FTRUNCATE 0x20000C9 + %define SYS_PWRITE 0x200009A + %define SYS_FORK 0x2000002 + %define SYS_WAITID 0x20000AD + %define SYS_EXIT 0x2000001 +%endif -global start, putc, putint, getc, exit, _builtin_malloc, _builtin_outofbounds +; mmap() and mprotect() flags +%ifidn __OUTPUT_FORMAT__,elf64 +; http://lxr.linux.no/linux+v3.13.5/include/uapi/asm-generic/mman-common.h + %define MAP_SHARED 0x01 + %define MAP_PRIVATE 0x02 + %define MAP_FIXED 0x10 + %define MAP_ANON 0x20 + %define PROT_NONE 0x0 + %define PROT_READ 0x1 + %define PROT_WRITE 0x2 + %define PROT_EXEC 0x4 + %define PROT_SEM 0x8 + %define PROT_GROWSDOWN 0x01000000 + %define PROT_GROWSUP 0x02000000 +%elifidn __OUTPUT_FORMAT__,macho64 +; http://www.opensource.apple.com/source/xnu/xnu-2050.18.24/bsd/sys/mman.h + %define MAP_SHARED 0x001 + %define MAP_PRIVATE 0x002 + %define MAP_FIXED 0x010 + %define MAP_RENAME 0x020 + %define MAP_NORESERVE 0x040 + %define MAP_INHERIT 0x080 + %define MAP_NOEXTEND 0x100 + %define MAP_SEMAPHORE 0x200 + %define MAP_NOCACHE 0x400 + %define MAP_JIT 0x800 + %define MAP_FILE 0x0000 + %define MAP_ANON 0x1000 + %define PROT_NONE 0x0 + %define PROT_READ 0x1 + %define PROT_WRITE 0x2 + %define PROT_EXEC 0x4 +%endif + +%define STDIN_FILENO 0 +%define STDOUT_FILENO 1 +%define STDERR_FILENO 2 + + +global start, _start, putc, putint, getc, exit, _builtin_malloc, _builtin_outofbounds default rel extern main section .text start: +_start: + and rsp, -16 ; make stack 16-byte aligned call main mov rdi, rax mov eax, SYS_EXIT @@ -25,7 +86,7 @@ putc: push rcx push r11 mov eax, SYS_WRITE - mov edi, 1 + mov edi, STDOUT_FILENO lea rsi, [rsp+56] mov edx, edi syscall @@ -91,7 +152,7 @@ getc: push rcx push r11 mov eax, SYS_READ - xor edi, edi + mov edi, STDIN_FILENO mov rsi, rsp mov edx, 1 syscall @@ -115,6 +176,73 @@ exit: syscall jmp $ +strlen: + push rbx + push rcx + push rdx + push rdi + push rsi + mov rsi, [rsp+8] ; string data pointer + mov rcx, [rsi-8] ; array size + xor edx, edx ; string walker + cmp rcx, 16 + jb .short + + movdqa [rsp], xmm1 + movdqa [rsp-16], xmm2 + + mov rax, rcx ; now array size + lea rbx, [rax-16] + pxor xmm2, xmm2 +.lp: + movdqu xmm1, [rsi+rdx] + pcmpistri xmm1, xmm2, 0x08 + js .nullfound + add rdx, 16 + cmp rdx, rbx + jbe .lp + + movdqa xmm2, [rsp-16] + movdqa xmm1, [rsp] + + cmp rdx, rax + je .nonull + + mov rcx, rax + sub rcx, rdx + +.short: + mov al, [rsi+rdx] + inc rdx + test al, al + loopnz .short + jnz .nonull + lea rax, [rdx-1] + pop rsi + pop rdi + pop rdx + pop rcx + pop rbx + ret + +.nullfound: + add rdx, rcx + mov rax, rdx + pop rsi + pop rdi + pop rdx + pop rcx + pop rbx + ret + +.nonull: + mov edi, STDERR_FILENO + lea rsi, [nonull_msg] + mov edx, nonull_msg.len + mov eax, SYS_WRITE + syscall + jmp exit255 + _builtin_malloc: push rdi push rsi @@ -126,12 +254,13 @@ _builtin_malloc: push rcx xor edi, edi mov rsi, [rsp+72] - mov edx, 0x03 - mov r10d, 0x1001 + mov edx, PROT_READ | PROT_WRITE + mov r10d, MAP_ANON | MAP_PRIVATE mov r8d, -1 xor r9d, r9d mov eax, SYS_MMAP syscall + add rax, 8 pop rcx pop r11 pop r10 @@ -143,11 +272,12 @@ _builtin_malloc: ret _builtin_outofbounds: - mov edi, 2 + mov edi, STDERR_FILENO lea rsi, [outofbounds_msg] mov rdx, outofbounds_msg.len mov eax, SYS_WRITE syscall +exit255: mov edi, 255 mov eax, SYS_EXIT syscall @@ -157,3 +287,5 @@ _builtin_outofbounds: section .data outofbounds_msg: db "Runtime Error: Out-of-bounds array access detected", 10 .len: equ $ - outofbounds_msg +nonull_msg: db "Runtime Error: No null byte found in string", 10 +.len: equ $ - nonull_msg |