Commit 0b3dcf9d authored by simonmar's avatar simonmar
Browse files

[project @ 2000-05-15 15:03:36 by simonmar]

I lied earlier.  _ccall_GC_ should work now.
parent 9cfc3137
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: AbsCSyn.lhs,v 1.29 2000/03/23 17:45:17 simonpj Exp $
% $Id: AbsCSyn.lhs,v 1.30 2000/05/15 15:03:36 simonmar Exp $
%
\section[AbstractC]{Abstract C: the last stop before machine code}
......@@ -473,6 +473,9 @@ data MagicId
PrimRep -- Int64Rep or Word64Rep
FAST_INT -- its number (1 .. mAX_Long_REG)
| CurrentTSO -- pointer to current thread's TSO
| CurrentNursery -- pointer to allocation area
node = VanillaReg PtrRep ILIT(1) -- A convenient alias for Node
tagreg = VanillaReg WordRep ILIT(2) -- A convenient alias for TagReg
......
......@@ -133,6 +133,8 @@ magicIdPrimRep Hp = PtrRep
magicIdPrimRep HpLim = PtrRep
magicIdPrimRep CurCostCentre = CostCentreRep
magicIdPrimRep VoidReg = VoidRep
magicIdPrimRep CurrentTSO = ThreadIdRep
magicIdPrimRep CurrentNursery = PtrRep
\end{code}
%************************************************************************
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CLabel.lhs,v 1.33 2000/04/13 11:56:35 simonpj Exp $
% $Id: CLabel.lhs,v 1.34 2000/05/15 15:03:36 simonmar Exp $
%
\section[CLabel]{@CLabel@: Information to make C Labels}
......@@ -418,7 +418,7 @@ pprCLbl (CaseLabel u CaseBitmap)
pprCLbl (RtsLabel RtsShouldNeverHappenCode) = ptext SLIT("stg_error_entry")
pprCLbl (RtsLabel RtsUpdInfo) = ptext SLIT("Upd_frame_info")
pprCLbl (RtsLabel RtsUpdInfo) = ptext SLIT("upd_frame_info")
pprCLbl (RtsLabel RtsTopTickyCtr) = ptext SLIT("top_ct")
......
......@@ -584,6 +584,8 @@ baseRegOffset (LongReg _ ILIT(2)) = OFFSET_Lng2
#endif
baseRegOffset Hp = OFFSET_Hp
baseRegOffset HpLim = OFFSET_HpLim
baseRegOffset CurrentTSO = OFFSET_CurrentTSO
baseRegOffset CurrentNursery = OFFSET_CurrentNursery
#ifdef DEBUG
baseRegOffset BaseReg = panic "baseRegOffset:BaseReg"
baseRegOffset CurCostCentre = panic "baseRegOffset:CurCostCentre"
......@@ -657,6 +659,12 @@ callerSaves Hp = True
#ifdef CALLER_SAVES_HpLim
callerSaves HpLim = True
#endif
#ifdef CALLER_SAVES_CurrentTSO
callerSaves CurrentTSO = True
#endif
#ifdef CALLER_SAVES_CurrentNursery
callerSaves CurrentNursery = True
#endif
callerSaves _ = False
\end{code}
......@@ -735,6 +743,12 @@ magicIdRegMaybe Hp = Just (FixedReg ILIT(REG_Hp))
#ifdef REG_HpLim
magicIdRegMaybe HpLim = Just (FixedReg ILIT(REG_HpLim))
#endif
#ifdef REG_CurrentTSO
magicIdRegMaybe CurrentTSO = Just (FixedReg ILIT(REG_CurrentTSO))
#endif
#ifdef REG_CurrentNursery
magicIdRegMaybe CurrentNursery = Just (FixedReg ILIT(REG_CurrentNursery))
#endif
magicIdRegMaybe _ = Nothing
\end{code}
......
......@@ -437,8 +437,8 @@ regUsage instr = case instr of
usageM (OpReg reg) = mkRU [reg] [reg]
usageM (OpAddr ea) = mkRU (use_EA ea) []
--callClobberedRegs = [ eax, ecx, edx ] -- according to gcc, anyway.
callClobberedRegs = [eax,fake0,fake1,fake2,fake3,fake4,fake5]
-- caller-saves registers
callClobberedRegs = [eax,ecx,edx,fake0,fake1,fake2,fake3,fake4,fake5]
-- Registers defd when an operand is written.
def_W (OpReg reg) = [reg]
......
......@@ -9,7 +9,8 @@ module Stix (
stixCountTempUses, stixSubst,
stgBaseReg, stgNode, stgSp, stgSu, stgSpLim,
stgHp, stgHpLim, stgTagReg, stgR9, stgR10,
stgHp, stgHpLim, stgTagReg, stgR9, stgR10,
stgCurrentTSO, stgCurrentNursery,
fixedHS, arrWordsHS, arrPtrsHS,
......@@ -227,6 +228,8 @@ stgSu = StReg (StixMagicId Su)
stgSpLim = StReg (StixMagicId SpLim)
stgHp = StReg (StixMagicId Hp)
stgHpLim = StReg (StixMagicId HpLim)
stgCurrentTSO = StReg (StixMagicId CurrentTSO)
stgCurrentNursery = StReg (StixMagicId CurrentNursery)
stgR9 = StReg (StixMagicId (VanillaReg WordRep ILIT(9)))
stgR10 = StReg (StixMagicId (VanillaReg WordRep ILIT(10)))
......
......@@ -205,7 +205,7 @@ bh_info, ind_static_info, ind_info :: StixTree
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_info")
upd_frame_info = sStLitLbl SLIT("upd_frame_info")
seq_frame_info = sStLitLbl SLIT("seq_frame_info")
-- Some common call trees
......
......@@ -14,17 +14,18 @@ import StixInteger
import AbsCSyn hiding ( spRel )
import AbsCUtils ( getAmodeRep, mixedTypeLocn )
import Constants ( uF_UPDATEE )
import SMRep ( fixedHdrSize )
import Literal ( Literal(..), word2IntLit )
import CallConv ( cCallConv )
import PrimOp ( PrimOp(..), CCall(..), CCallTarget(..) )
import PrimRep ( PrimRep(..), isFloatingRep )
import UniqSupply ( returnUs, thenUs, getUniqueUs, UniqSM )
import Constants ( mIN_INTLIKE )
import Constants ( mIN_INTLIKE, uF_UPDATEE, bLOCK_SIZE )
import Outputable
import Char ( ord )
import Char ( ord, isAlphaNum )
#include "NCG.h"
\end{code}
The main honcho here is primCode, which handles the guts of COpStmts.
......@@ -242,14 +243,17 @@ primCode lhs (CCallOp (CCall (StaticTarget fn) is_asm may_gc cconv)) rhs
| is_asm = error "ERROR: Native code generator can't handle casm"
| not may_gc = returnUs (\xs -> ccall : xs)
| otherwise =
save_thread_state `thenUs` \ save ->
load_thread_state `thenUs` \ load ->
getUniqueUs `thenUs` \ uniq ->
let
id = StReg (StixTemp uniq IntRep)
id = StReg (StixTemp uniq IntRep)
suspend = StAssign IntRep id
(StCall SLIT("suspendThread") cconv IntRep [stgBaseReg])
resume = StCall SLIT("resumeThread") cconv VoidRep [id]
in
returnUs (\xs -> suspend : ccall : resume : xs)
returnUs (\xs -> save (suspend : ccall : resume : load xs))
where
args = map amodeCodeForCCall rhs
......@@ -459,12 +463,11 @@ amodeToStix (CMacroExpr _ macro [arg])
litLitToStix :: String -> StixTree
litLitToStix nm
= case nm of
"stdout" -> stixFor_stdout
"stderr" -> stixFor_stderr
"stdin" -> stixFor_stdin
other -> error ("\nlitLitToStix: can't handle `" ++ nm ++ "'\n"
| all is_id nm = StLitLbl (text nm)
| otherwise = error ("\nlitLitToStix: can't handle `" ++ nm ++ "'\n"
++ "suggested workaround: use flag -fvia-C\n")
where is_id c = isAlphaNum c || c == '_'
\end{code}
Sizes of the CharLike and IntLike closures that are arranged as arrays
......@@ -495,3 +498,62 @@ mutArrPtrsFrozen_info = sStLitLbl SLIT("MUT_ARR_PTRS_FROZEN_info")
charLikeSize = (fixedHdrSize + 1) * (fromInteger (sizeOf PtrRep))
intLikeSize = (fixedHdrSize + 1) * (fromInteger (sizeOf PtrRep))
\end{code}
\begin{code}
save_thread_state
= getUniqueUs `thenUs` \tso_uq ->
let tso = StReg (StixTemp tso_uq ThreadIdRep) in
returnUs (\xs ->
StAssign ThreadIdRep tso stgCurrentTSO :
StAssign PtrRep
(StInd PtrRep (StPrim IntAddOp
[tso, StInt (toInteger (TSO_SP*BYTES_PER_WORD))]))
stgSp :
StAssign PtrRep
(StInd PtrRep (StPrim IntAddOp
[tso, StInt (toInteger (TSO_SU*BYTES_PER_WORD))]))
stgSu :
StAssign PtrRep
(StInd PtrRep (StPrim IntAddOp
[tso, StInt (toInteger (TSO_SPLIM*BYTES_PER_WORD))]))
stgSpLim :
StAssign PtrRep
(StInd PtrRep (StPrim IntAddOp
[stgCurrentNursery,
StInt (toInteger (BDESCR_FREE * BYTES_PER_WORD))]))
(StPrim IntAddOp [stgHp, StInt (toInteger (1 * BYTES_PER_WORD))]) :
xs
)
load_thread_state
= getUniqueUs `thenUs` \tso_uq ->
let tso = StReg (StixTemp tso_uq ThreadIdRep) in
returnUs (\xs ->
StAssign ThreadIdRep tso stgCurrentTSO :
StAssign PtrRep stgSp
(StInd PtrRep (StPrim IntAddOp
[tso, StInt (toInteger (TSO_SP*BYTES_PER_WORD))])) :
StAssign PtrRep stgSu
(StInd PtrRep (StPrim IntAddOp
[tso, StInt (toInteger (TSO_SU*BYTES_PER_WORD))])) :
StAssign PtrRep stgSpLim
(StInd PtrRep (StPrim IntAddOp
[tso, StInt (toInteger (TSO_SPLIM*BYTES_PER_WORD))])) :
StAssign PtrRep stgHp
(StPrim IntSubOp [
StInd PtrRep (StPrim IntAddOp
[stgCurrentNursery,
StInt (toInteger (BDESCR_FREE * BYTES_PER_WORD))]),
StInt (toInteger (1 * BYTES_PER_WORD))
]) :
StAssign PtrRep stgHpLim
(StPrim IntAddOp [
StInd PtrRep (StPrim IntAddOp
[stgCurrentNursery,
StInt (toInteger (BDESCR_START * BYTES_PER_WORD))]),
StInt (toInteger (bLOCK_SIZE - (1 * BYTES_PER_WORD)))
]) :
xs
)
\end{code}
Supports Markdown
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