Commit de5fbb69 authored by simonm's avatar simonm
Browse files

[project @ 1999-03-01 17:41:21 by simonm]

Some native codegen updates.
parent 323ca12e
......@@ -14,19 +14,34 @@ module SMRep (
#ifndef OMIT_NATIVE_CODEGEN
, getSMRepClosureTypeInt
, cONSTR
, cONSTR_STATIC
, cONSTR_NOCAF_STATIC
, fUN
, fUN_STATIC
, tHUNK
, tHUNK_STATIC
, tHUNK_SELECTOR
, rET_SMALL
, rET_VEC_SMALL
, rET_BIG
, cONSTR
, cONSTR_1_0
, cONSTR_0_1
, cONSTR_2_0
, cONSTR_1_1
, cONSTR_0_2
, cONSTR_STATIC
, cONSTR_NOCAF_STATIC
, fUN
, fUN_1_0
, fUN_0_1
, fUN_2_0
, fUN_1_1
, fUN_0_2
, fUN_STATIC
, tHUNK
, tHUNK_1_0
, tHUNK_0_1
, tHUNK_2_0
, tHUNK_1_1
, tHUNK_0_2
, tHUNK_STATIC
, tHUNK_SELECTOR
, rET_SMALL
, rET_VEC_SMALL
, rET_BIG
, rET_VEC_BIG
, bLACKHOLE
, bLACKHOLE
#endif
) where
......@@ -34,9 +49,9 @@ module SMRep (
import CmdLineOpts
import AbsCSyn ( Liveness(..) )
import Constants ( sTD_HDR_SIZE, pROF_HDR_SIZE,
import Constants ( sTD_HDR_SIZE, pROF_HDR_SIZE,
gRAN_HDR_SIZE, tICKY_HDR_SIZE, aRR_HDR_SIZE,
sTD_ITBL_SIZE, pROF_ITBL_SIZE,
sTD_ITBL_SIZE, pROF_ITBL_SIZE,
gRAN_ITBL_SIZE, tICKY_ITBL_SIZE )
import Outputable
import GlaExts ( Int(..), Int#, (<#), (==#), (<#), (>#) )
......@@ -158,14 +173,29 @@ pprClosureType THUNK_SELECTOR = ptext SLIT("THUNK_SELECTOR")
#ifndef OMIT_NATIVE_CODEGEN
getSMRepClosureTypeInt :: SMRep -> Int
getSMRepClosureTypeInt (GenericRep _ _ t) =
case t of
case t of
CONSTR -> cONSTR
CONSTR_p_n 1 0 -> cONSTR_1_0
CONSTR_p_n 0 1 -> cONSTR_0_1
CONSTR_p_n 2 0 -> cONSTR_2_0
CONSTR_p_n 1 1 -> cONSTR_1_1
CONSTR_p_n 0 2 -> cONSTR_0_2
CONSTR_NOCAF -> panic "getClosureTypeInt: CONSTR_NOCAF"
FUN -> fUN
FUN_p_n 1 0 -> fUN_1_0
FUN_p_n 0 1 -> fUN_0_1
FUN_p_n 2 0 -> fUN_2_0
FUN_p_n 1 1 -> fUN_1_1
FUN_p_n 0 2 -> fUN_0_2
THUNK -> tHUNK
THUNK_p_n 1 0 -> tHUNK_1_0
THUNK_p_n 0 1 -> tHUNK_0_1
THUNK_p_n 2 0 -> tHUNK_2_0
THUNK_p_n 1 1 -> tHUNK_1_1
THUNK_p_n 0 2 -> tHUNK_0_2
THUNK_SELECTOR -> tHUNK_SELECTOR
getSMRepClosureTypeInt (StaticRep _ _ t) =
case t of
case t of
CONSTR -> cONSTR_STATIC
CONSTR_NOCAF -> cONSTR_NOCAF_STATIC
FUN -> fUN_STATIC
......@@ -181,11 +211,26 @@ getSMRepClosureTypeInt BlackHoleRep = bLACKHOLE
#include "../includes/ClosureTypes.h"
cONSTR = (CONSTR :: Int)
cONSTR_1_0 = (CONSTR_1_0 :: Int)
cONSTR_0_1 = (CONSTR_0_1 :: Int)
cONSTR_2_0 = (CONSTR_2_0 :: Int)
cONSTR_1_1 = (CONSTR_1_1 :: Int)
cONSTR_0_2 = (CONSTR_0_2 :: Int)
cONSTR_STATIC = (CONSTR_STATIC :: Int)
cONSTR_NOCAF_STATIC = (CONSTR_NOCAF_STATIC :: Int)
fUN = (FUN :: Int)
fUN_1_0 = (FUN_1_0 :: Int)
fUN_0_1 = (FUN_0_1 :: Int)
fUN_2_0 = (FUN_2_0 :: Int)
fUN_1_1 = (FUN_1_1 :: Int)
fUN_0_2 = (FUN_0_2 :: Int)
fUN_STATIC = (FUN_STATIC :: Int)
tHUNK = (THUNK :: Int)
tHUNK_1_0 = (THUNK_1_0 :: Int)
tHUNK_0_1 = (THUNK_0_1 :: Int)
tHUNK_2_0 = (THUNK_2_0 :: Int)
tHUNK_1_1 = (THUNK_1_1 :: Int)
tHUNK_0_2 = (THUNK_0_2 :: Int)
tHUNK_STATIC = (THUNK_STATIC :: Int)
tHUNK_SELECTOR = (THUNK_SELECTOR :: Int)
rET_SMALL = (RET_SMALL :: Int)
......
......@@ -757,7 +757,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
mkSeqInstr (LEA sz (OpAddr (AddrBaseIndex (Just src1) Nothing src2)) (OpReg dst))
in
returnUs (Any IntRep code__2)
{-
add_code sz x (StInd _ mem)
= getRegister x `thenUs` \ register1 ->
--getNewRegNCG (registerRep register1)
......@@ -767,7 +767,6 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
code2 = amodeCode amode
src2 = amodeAddr amode
-- fixedname = registerName register1 eax
code__2 dst = let code1 = registerCode register1 dst
src1 = registerName register1 dst
in asmParThen [code2 asmVoid,code1 asmVoid] .
......@@ -788,7 +787,6 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
code1 = amodeCode amode
src1 = amodeAddr amode
-- fixedname = registerName register2 eax
code__2 dst = let code2 = registerCode register2 dst
src2 = registerName register2 dst
in asmParThen [code1 asmVoid,code2 asmVoid] .
......@@ -799,7 +797,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
mkSeqInstrs [ADD sz (OpAddr src1) (OpReg src2)]
in
returnUs (Any IntRep code__2)
-}
add_code sz x y
= getRegister x `thenUs` \ register1 ->
getRegister y `thenUs` \ register2 ->
......@@ -2786,7 +2784,6 @@ trivialCode instr x y
= getRegister x `thenUs` \ register1 ->
--getNewRegNCG IntRep `thenUs` \ tmp1 ->
let
-- fixedname = registerName register1 eax
code__2 dst = let code1 = registerCode register1 dst
src1 = registerName register1 dst
in code1 .
......@@ -2806,7 +2803,6 @@ trivialCode instr x y
= getRegister y `thenUs` \ register1 ->
--getNewRegNCG IntRep `thenUs` \ tmp1 ->
let
-- fixedname = registerName register1 eax
code__2 dst = let code1 = registerCode register1 dst
src1 = registerName register1 dst
in code1 .
......@@ -2820,13 +2816,12 @@ trivialCode instr x y
where
imm = maybeImm x
imm__2 = case imm of Just x -> x
{-
trivialCode instr x (StInd pk mem)
= getRegister x `thenUs` \ register ->
--getNewRegNCG IntRep `thenUs` \ tmp ->
getAmode mem `thenUs` \ amode ->
let
-- fixedname = registerName register eax
code2 = amodeCode amode asmVoid
src2 = amodeAddr amode
code__2 dst = let code1 = registerCode register dst asmVoid
......@@ -2845,7 +2840,6 @@ trivialCode instr (StInd pk mem) y
--getNewRegNCG IntRep `thenUs` \ tmp ->
getAmode mem `thenUs` \ amode ->
let
-- fixedname = registerName register eax
code2 = amodeCode amode asmVoid
src2 = amodeAddr amode
code__2 dst = let
......@@ -2859,14 +2853,13 @@ trivialCode instr (StInd pk mem) y
mkSeqInstr (instr (OpAddr src2) (OpReg src1))
in
returnUs (Any pk code__2)
-}
trivialCode instr x y
= getRegister x `thenUs` \ register1 ->
getRegister y `thenUs` \ register2 ->
--getNewRegNCG IntRep `thenUs` \ tmp1 ->
getNewRegNCG IntRep `thenUs` \ tmp2 ->
let
-- fixedname = registerName register1 eax
code2 = registerCode register2 tmp2 asmVoid
src2 = registerName register2 tmp2
code__2 dst = let
......@@ -2886,7 +2879,6 @@ trivialUCode instr x
= getRegister x `thenUs` \ register ->
-- getNewRegNCG IntRep `thenUs` \ tmp ->
let
-- fixedname = registerName register eax
code__2 dst = let
code = registerCode register dst
src = registerName register dst
......@@ -3241,7 +3233,6 @@ chrCode x
= getRegister x `thenUs` \ register ->
--getNewRegNCG IntRep `thenUs` \ reg ->
let
-- fixedname = registerName register eax
code__2 dst = let
code = registerCode register dst
src = registerName register dst
......
......@@ -76,7 +76,7 @@ macroCode UPD_CAF args
blocking_queue = StInd PtrRep (StIndex PtrRep bhptr fixedHS)
a1 = StAssign PtrRep w0 ind_static_info
a2 = StAssign PtrRep w1 bhptr
a3 = StAssign PtrRep blocking_queue end_tso_queue
a3 = StCall SLIT("newCAF") cCallConv VoidRep [cafptr]
in
returnUs (\xs -> a1 : a2 : a3 : xs)
\end{code}
......@@ -161,7 +161,6 @@ bh_info = sStLitLbl SLIT("BLACKHOLE_info")
ind_static_info = sStLitLbl SLIT("IND_STATIC_info")
ind_info = sStLitLbl SLIT("IND_info")
upd_frame_info = sStLitLbl SLIT("Upd_frame_entry")
end_tso_queue = sStLitLbl SLIT("END_TSO_QUEUE_closure")
-- Some common call trees
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment