From f0ee8b7265e07c735539d47ea646ca0cf0634d05 Mon Sep 17 00:00:00 2001
From: sewardj <unknown>
Date: Tue, 18 Jan 2000 15:59:53 +0000
Subject: [PATCH] [project @ 2000-01-18 15:59:53 by sewardj] genCCall for x86
assumed that all args were 4 bytes long :-(. Now works with doubles too.
---
ghc/compiler/nativeGen/MachCode.lhs | 56 ++++++++++++-----------------
1 file changed, 23 insertions(+), 33 deletions(-)
diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs
index 17922ee4bd01..8bd1d231105d 100644
--- a/ghc/compiler/nativeGen/MachCode.lhs
+++ b/ghc/compiler/nativeGen/MachCode.lhs
@@ -2284,48 +2284,27 @@ genCCall fn cconv kind args
genCCall fn cconv kind [StInt i]
| fn == SLIT ("PerformGC_wrapper")
- = let
- call = [MOV L (OpImm (ImmInt (fromInteger i))) (OpReg eax),
- CALL (ImmLit (ptext (if underscorePrefix then (SLIT ("_PerformGC_wrapper")) else (SLIT ("PerformGC_wrapper")))))]
+ = let call = [MOV L (OpImm (ImmInt (fromInteger i))) (OpReg eax),
+ CALL (ImmLit (ptext (if underscorePrefix
+ then (SLIT ("_PerformGC_wrapper"))
+ else (SLIT ("PerformGC_wrapper")))))]
in
returnInstrs call
-{- OLD:
- = getUniqLabelNCG `thenUs` \ lbl ->
- let
- call = [MOV L (OpImm (ImmInt (fromInteger i))) (OpReg eax),
- MOV L (OpImm (ImmCLbl lbl))
- -- this is hardwired
- (OpAddr (AddrBaseIndex (Just ebx) Nothing (ImmInt 104))),
- JMP (OpImm (ImmLit (ptext (if underscorePrefix then (SLIT ("_PerformGC_wrapper")) else (SLIT ("PerformGC_wrapper")))))),
- LABEL lbl]
- in
- returnInstrs call
--}
genCCall fn cconv kind args
- = mapUs get_call_arg args `thenUs` \ argCode ->
+ = mapUs get_call_arg args `thenUs` \ sizes_and_argCodes ->
let
- nargs = length args
+ (sizes, argCode) = unzip sizes_and_argCodes
+ tot_arg_size = sum (map (\sz -> case sz of DF -> 8; _ -> 4) sizes)
-{- OLD: Since there's no attempt at stealing %esp at the moment,
- restoring %esp from MainRegTable.rCstkptr is not done. -- SOF 97/09
- (ditto for saving away old-esp in MainRegTable.Hp (!!) )
- code1 = asmParThen [asmSeq [ -- MOV L (OpReg esp) (OpAddr (AddrBaseIndex (Just ebx) Nothing (ImmInt 80))),
- MOV L (OpAddr (AddrBaseIndex (Just ebx) Nothing (ImmInt 100))) (OpReg esp)
- ]
- ]
--}
code2 = asmParThen (map ($ asmVoid) (reverse argCode))
call = [CALL fn__2 ,
- -- pop args; all args word sized?
- ADD L (OpImm (ImmInt (nargs * 4))) (OpReg esp) --,
-
- -- Don't restore %esp (see above)
- -- MOV L (OpAddr (AddrBaseIndex (Just ebx) Nothing (ImmInt 80))) (OpReg esp)
- ]
+ ADD L (OpImm (ImmInt tot_arg_size)) (OpReg esp)
+ ]
in
returnSeq (code2) call
+
where
-- function names that begin with '.' are assumed to be special
-- internally generated names like '.mul,' which don't get an
@@ -2336,11 +2315,22 @@ genCCall fn cconv kind args
_ -> ImmLab (ptext fn)
------------
- get_call_arg :: StixTree{-current argument-} -> UniqSM InstrBlock -- code
+ get_call_arg :: StixTree{-current argument-}
+ -> UniqSM (Size, InstrBlock) -- arg size, code
get_call_arg arg
= get_op arg `thenUs` \ (code, op, sz) ->
- returnUs (code . mkSeqInstr (PUSH sz op))
+ case sz of
+ DF -> returnUs (sz,
+ code .
+ mkSeqInstr (FLD L op) .
+ mkSeqInstr (SUB L (OpImm (ImmInt 8)) (OpReg esp)) .
+ mkSeqInstr (FSTP DF (OpAddr (AddrBaseIndex
+ (Just esp)
+ Nothing (ImmInt 0))))
+ )
+ _ -> returnUs (sz,
+ code . mkSeqInstr (PUSH sz op))
------------
get_op
--
GitLab