<commit_before>%
% (c) The AQUA Project, Glasgow University, 1993-1998
%

\begin{code}
module StixPrim ( primCode, amodeToStix, amodeToStix', foreignCallCode )
  where

#include "HsVersions.h"

import MachMisc
import Stix
import StixInteger

import AbsCSyn 		hiding ( spRel )
import AbsCUtils	( getAmodeRep, mixedTypeLocn )
import SMRep		( fixedHdrSize )
import Literal		( Literal(..), word2IntLit )
import PrimOp		( PrimOp(..) )
import PrimRep		( PrimRep(..), getPrimRepSizeInBytes )
import UniqSupply	( returnUs, thenUs, getUniqueUs, UniqSM )
import Constants	( mIN_INTLIKE, mIN_CHARLIKE, uF_UPDATEE, bLOCK_SIZE,
			  rESERVED_STACK_WORDS )
import CLabel		( mkIntlikeClosureLabel, mkCharlikeClosureLabel,
			  mkMAP_FROZEN_infoLabel, mkEMPTY_MVAR_infoLabel,
			  mkForeignLabel )
import ForeignCall	( ForeignCall(..), CCallSpec(..), CCallTarget(..),
			  CCallConv(..), playSafe )
import Outputable
import FastTypes

#include "NCG.h"
\end{code}

The main honchos here are primCode anf foreignCallCode, which handle the guts of COpStmts.

\begin{code}
foreignCallCode
    :: [CAddrMode]  	-- results
    -> ForeignCall    	-- op
    -> [CAddrMode]  	-- args
    -> UniqSM StixTreeList

primCode
    :: [CAddrMode]  	-- results
    -> PrimOp 	    	-- op
    -> [CAddrMode]  	-- args
    -> UniqSM StixTreeList
\end{code}

%************************************************************************
%*									*
\subsubsection{Code for foreign calls}
%*									*
%************************************************************************

First, the dreaded @ccall@.  We can't handle @casm@s.

Usually, this compiles to an assignment, but when the left-hand side
is empty, we just perform the call and ignore the result.

btw Why not let programmer use casm to provide assembly code instead
of C code?  ADR

ToDo: saving/restoring of volatile regs around ccalls.

JRS, 001113: always do the call of suspendThread and resumeThread as a ccall
rather than inheriting the calling convention of the thing which we're really
calling.

\begin{code}
foreignCallCode lhs (CCall (CCallSpec (StaticTarget fn) cconv safety is_asm)) rhs
  | not (playSafe safety) = returnUs (\xs -> ccall : xs)

  | otherwise
  = save_thread_state	`thenUs` \ save ->
    load_thread_state	`thenUs` \ load -> 
    getUniqueUs		`thenUs` \ uniq -> 
    let
       id  = StReg (StixTemp uniq IntRep)
    
       suspend = StAssign IntRep id 
    		(StCall SLIT("suspendThread") {-no:cconv-} CCallConv
                            IntRep [stgBaseReg])
       resume  = StCall SLIT("resumeThread") {-no:cconv-} CCallConv
                        VoidRep [id]
    in
    returnUs (\xs -> save (suspend : ccall : resume : load xs))

  where
    args = map amodeCodeForCCall rhs
    amodeCodeForCCall x =
	let base = amodeToStix' x
	in
	    case getAmodeRep x of
	      ArrayRep      -> StIndex PtrRep base arrPtrsHS
	      ByteArrayRep  -> StIndex IntRep base arrWordsHS
	      ForeignObjRep -> StInd PtrRep (StIndex PtrRep base fixedHS)
	      _ -> base<commit_msg>[project @ 2001-05-24 15:01:33 by simonpj] wibble<commit_after>%
% (c) The AQUA Project, Glasgow University, 1993-1998
%

\begin{code}
module StixPrim ( primCode, amodeToStix, amodeToStix', foreignCallCode )
  where

#include "HsVersions.h"

import MachMisc
import Stix
import StixInteger

import AbsCSyn 		hiding ( spRel )
import AbsCUtils	( getAmodeRep, mixedTypeLocn )
import SMRep		( fixedHdrSize )
import Literal		( Literal(..), word2IntLit )
import PrimOp		( PrimOp(..) )
import PrimRep		( PrimRep(..), getPrimRepSizeInBytes )
import UniqSupply	( returnUs, thenUs, getUniqueUs, UniqSM )
import Constants	( mIN_INTLIKE, mIN_CHARLIKE, uF_UPDATEE, bLOCK_SIZE,
			  rESERVED_STACK_WORDS )
import CLabel		( mkIntlikeClosureLabel, mkCharlikeClosureLabel,
			  mkMAP_FROZEN_infoLabel, mkEMPTY_MVAR_infoLabel,
			  mkForeignLabel )
import ForeignCall	( ForeignCall(..), CCallSpec(..), CCallTarget(..),
			  CCallConv(..), playSafe )
import Outputable
import FastTypes

#include "NCG.h"
\end{code}

The main honchos here are primCode anf foreignCallCode, which handle the guts of COpStmts.

\begin{code}
foreignCallCode
    :: [CAddrMode]  	-- results
    -> ForeignCall    	-- op
    -> [CAddrMode]  	-- args
    -> UniqSM StixTreeList

primCode
    :: [CAddrMode]  	-- results
    -> PrimOp 	    	-- op
    -> [CAddrMode]  	-- args
    -> UniqSM StixTreeList
\end{code}

%************************************************************************
%*									*
\subsubsection{Code for foreign calls}
%*									*
%************************************************************************

First, the dreaded @ccall@.  We can't handle @casm@s.

Usually, this compiles to an assignment, but when the left-hand side
is empty, we just perform the call and ignore the result.

btw Why not let programmer use casm to provide assembly code instead
of C code?  ADR

ToDo: saving/restoring of volatile regs around ccalls.

JRS, 001113: always do the call of suspendThread and resumeThread as a ccall
rather than inheriting the calling convention of the thing which we're really
calling.

\begin{code}
foreignCallCode lhs (CCall (CCallSpec (StaticTarget fn) cconv safety)) rhs
  | not (playSafe safety) = returnUs (\xs -> ccall : xs)

  | otherwise
  = save_thread_state	`thenUs` \ save ->
    load_thread_state	`thenUs` \ load -> 
    getUniqueUs		`thenUs` \ uniq -> 
    let
       id  = StReg (StixTemp uniq IntRep)
    
       suspend = StAssign IntRep id 
    		(StCall SLIT("suspendThread") {-no:cconv-} CCallConv
                            IntRep [stgBaseReg])
       resume  = StCall SLIT("resumeThread") {-no:cconv-} CCallConv
                        VoidRep [id]
    in
    returnUs (\xs -> save (suspend : ccall : resume : load xs))

  where
    args = map amodeCodeForCCall rhs
    amodeCodeForCCall x =
	let base = amodeToStix' x
	in
	    case getAmodeRep x of
	      ArrayRep      -> StIndex PtrRep base arrPtrsHS
	      ByteArrayRep  -> StIndex IntRep base arrWordsHS
	      ForeignObjRep -> StInd PtrRep (StIndex PtrRep base fixedHS)
	      _ -> base
{'fraction_non_alphanumeric': 0.1348148148148148, 'fraction_numerical': 0.007242798353909465, 'mean_word_length': 3.260869565217391, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 33, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4993219', 'n_tokens_mistral': 2139, 'n_tokens_neox': 2011, 'n_words': 585}