suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Nearer to getting code to compile -- now needs constant pullups

Browse Source
This commit is contained in:
Adam Sampson 2007-04-12 03:09:11 +00:00
parent 81d59f40de
commit fd1f559d5c
7 changed files with 65 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
fco2/AST.hs
View File

@ -86,7 +86,8 @@ data Expression =
| Dyadic Meta DyadicOp Expression Expression
| MostPos Meta Type
| MostNeg Meta Type
| Size Meta Type
| SizeType Meta Type
| SizeExpr Meta Expression
| Conversion Meta ConversionMode Type Expression
| ExprVariable Meta Variable
| ExprLiteral Meta Literal
@ -108,7 +109,6 @@ data MonadicOp =
MonadicSubtr
| MonadicBitNot
| MonadicNot
| MonadicSize
deriving (Show, Eq, Typeable, Data)
data DyadicOp =

18
fco2/GenerateC.hs
View File

@ -247,7 +247,11 @@ genExpression (A.Monadic m op e) = genMonadic op e
genExpression (A.Dyadic m op e f) = genDyadic op e f
genExpression (A.MostPos m t) = genTypeConstant "mostpos" t
genExpression (A.MostNeg m t) = genTypeConstant "mostneg" t
--genExpression (A.Size m t)
--genExpression (A.SizeType m t)
-- FIXME This needs to cope with subscripts
genExpression (A.SizeExpr m e)
= do genExpression e
tell ["_sizes[0]"]
genExpression (A.Conversion m cm t e) = genConversion cm t e
genExpression (A.ExprVariable m v) = genVariable v
genExpression (A.ExprLiteral m l) = genLiteral l
@ -282,10 +286,6 @@ genMonadic :: A.MonadicOp -> A.Expression -> CGen ()
genMonadic A.MonadicSubtr e = genSimpleMonadic "-" e
genMonadic A.MonadicBitNot e = genSimpleMonadic "~" e
genMonadic A.MonadicNot e = genSimpleMonadic "!" e
-- FIXME This needs to cope with subscripts
genMonadic A.MonadicSize e
= do genExpression e
tell ["_sizes[0]"]
genSimpleDyadic :: String -> A.Expression -> A.Expression -> CGen ()
genSimpleDyadic s e f
@ -616,6 +616,11 @@ genActual (actual, A.Formal am t _)
r
Nothing -> return ()
numCArgs :: [A.Formal] -> Int
numCArgs [] = 0
numCArgs (A.Formal _ (A.Array _ _) _:fs) = 2 + numCArgs fs
numCArgs (_:fs) = 1 + numCArgs fs
genFormals :: [A.Formal] -> CGen ()
genFormals fs = sequence_ $ intersperse genComma (map genFormal fs)
@ -764,7 +769,8 @@ genProcAlloc (pid, A.ProcCall m n as)
ps <- get
let fs = case fromJust $ specTypeOfName ps n of A.Proc _ fs _ -> fs
-- FIXME stack size fixed here
tell [", 4096"]
let stackSize = 4096
tell [", ", show stackSize, ", ", show $ numCArgs fs]
sequence_ $ map (\a -> do tell [", "]
genActual a) (zip as fs)
tell [");\n"]

6
fco2/Makefile
View File

@ -18,6 +18,12 @@ sources = \
$(targets): $(sources)
ghc -fglasgow-exts -o fco --make Main
%.fco.c: %.occ fco
./fco $< >$@
%.fco.o: %.fco.c
gcc -g -std=gnu99 -Wall `kroc --cflags` `kroc --ccincpath` -c $<
tests = $(wildcard testcases/*.occ)
test: $(targets) $(tests)

8
fco2/Parse.hs
View File

@ -590,8 +590,8 @@ sizeExpr :: OccParser A.Expression
sizeExpr
= do m <- md
sSIZE
(try (do { t <- dataType; return $ A.Size m t })
<|> do { v <- operand; return $ A.Monadic m A.MonadicSize v })
(try (do { t <- dataType; return $ A.SizeType m t })
<|> do { v <- operand; return $ A.SizeExpr m v })
<?> "sizeExpr"
booleanExpr :: OccParser A.Expression
@ -815,8 +815,8 @@ definition
<|> do { eol; indent; fs' <- scopeInFormals fs; vp <- valueProcess; scopeOutFormals fs'; outdent; sColon; eol; return (n, A.Function m rs fs' vp) } })
<|> try (do { m <- md; s <- specifier; n <- newVariableName ;
sRETYPES <|> sRESHAPES; v <- variable; sColon; eol; return (n, A.Retypes m A.Abbrev s v) })
<|> do { m <- md; sVAL; s <- specifier; n <- newVariableName ;
sRETYPES <|> sRESHAPES; e <- expression; sColon; eol; return (n, A.RetypesExpr m A.ValAbbrev s e) }
<|> try (do { m <- md; sVAL; s <- specifier; n <- newVariableName ;
sRETYPES <|> sRESHAPES; e <- expression; sColon; eol; return (n, A.RetypesExpr m A.ValAbbrev s e) })
<?> "definition"
dataSpecifier :: OccParser A.Type

28
fco2/Types.hs
View File

@ -48,25 +48,37 @@ abbrevModeOfVariable :: ParseState -> A.Variable -> Maybe A.AbbrevMode
abbrevModeOfVariable ps (A.Variable _ n) = abbrevModeOfName ps n
abbrevModeOfVariable ps (A.SubscriptedVariable _ _ v) = abbrevModeOfVariable ps v
dyadicIsBoolean :: A.DyadicOp -> Bool
dyadicIsBoolean A.Eq = True
dyadicIsBoolean A.NotEq = True
dyadicIsBoolean A.Less = True
dyadicIsBoolean A.More = True
dyadicIsBoolean A.LessEq = True
dyadicIsBoolean A.MoreEq = True
dyadicIsBoolean A.After = True
dyadicIsBoolean _ = False
typeOfExpression :: ParseState -> A.Expression -> Maybe A.Type
typeOfExpression ps e
= case e of
A.Monadic m op e -> typeOfExpression ps e
A.Dyadic m op e f -> typeOfExpression ps e -- assume f's been checked!
A.Dyadic m op e f ->
if dyadicIsBoolean op then Just A.Bool else typeOfExpression ps e
A.MostPos m t -> Just t
A.MostNeg m t -> Just t
A.Size m t -> Just A.Int
A.SizeType m t -> Just A.Int
A.SizeExpr m t -> Just A.Int
A.Conversion m cm t e -> Just t
A.ExprVariable m v -> typeOfVariable ps v
A.ExprLiteral m l -> typeOfLiteral ps l
A.True m -> Just A.Bool
A.False m -> Just A.Bool
A.FunctionCall m n es
-> case returnTypesOfFunction ps n of
Just [t] -> Just t
_ -> Nothing
A.SubscriptedExpr m s e
-> typeOfExpression ps e >>= subscriptType
A.FunctionCall m n es ->
case returnTypesOfFunction ps n of
Just [t] -> Just t
_ -> Nothing
A.SubscriptedExpr m s e ->
typeOfExpression ps e >>= subscriptType
A.BytesInExpr m e -> Just A.Int
A.BytesInType m t -> Just A.Int
A.OffsetOf m t n -> Just A.Int

16
fco2/fco_support.h
View File

@ -3,10 +3,14 @@
#ifndef FCO_SUPPORT_H
#define FCO_SUPPORT_H
#include <stddef.h>
#include <stdbool.h>
#include <stdint.h>
#include <limits.h>
#include <float.h>
#include <cifccsp.h>
#define occam_mostneg_bool false
#define occam_mostpos_bool true
#define occam_mostneg_char CHAR_MIN
@ -25,28 +29,28 @@
#define occam_mostpos_double DBL_MAX
/* FIXME All of these need to check for overflow and report errors appropriately. */
static int occam_add(int a, int b) {
static int occam_add (int a, int b) {
return a + b;
}
static int occam_subtr(int a, int b) {
static int occam_subtr (int a, int b) {
return a - b;
}
static int occam_mul(int a, int b) {
static int occam_mul (int a, int b) {
return a * b;
}
static int occam_div(int a, int b) {
static int occam_div (int a, int b) {
if (b == 0) {
SetErr ();
}
return a / b;
}
static int occam_rem(int a, int b) {
static int occam_rem (int a, int b) {
if (b == 0) {
SetErr ();
}
return a % b;
}
static bool occam_after(int a, int b) {
static bool occam_after (int a, int b) {
return (a - b) > 0;
}

22
fco2/testcases/commstime-mini.occ
View File

@ -1,14 +1,14 @@
-- A standalone occam 2 version of the stock commstime benchmark.
--{{{ stuff from libcourse
--{{{ PROC out.repeat (VAL BYTE ch, VAL INT n, CHAN BYTE out)
--{{{ PROC out.repeat (VAL BYTE ch, VAL INT n, CHAN OF BYTE out)
--* Write a character repeatedly to a channel.
-- This outputs [@code ch] down the channel [@code out] [@code n] times. If
-- [@code n] is negative, nothing happens.
-- @param ch Character
-- @param n Number of times to output (negative values result in no output)
-- @param out Channel to write to
PROC out.repeat (VAL BYTE ch, VAL INT n, CHAN BYTE out)
PROC out.repeat (VAL BYTE ch, VAL INT n, CHAN OF BYTE out)
--{{{
IF
n > 0
@ -19,42 +19,42 @@ PROC out.repeat (VAL BYTE ch, VAL INT n, CHAN BYTE out)
--}}}
:
--}}}
--{{{ PROC out.string (VAL []BYTE s, VAL INT field, CHAN BYTE out)
--{{{ PROC out.string (VAL []BYTE s, VAL INT field, CHAN OF BYTE out)
--* Write a string to a channel.
-- This outputs [@code s] in a fieldwidth [@code field] down [@code out].
-- @param s String
-- @param field Field width to right-justify in
-- @param out Channel to write to
PROC out.string (VAL []BYTE s, VAL INT field, CHAN BYTE out)
PROC out.string (VAL []BYTE s, VAL INT field, CHAN OF BYTE out)
--{{{
VAL INT length IS SIZE s:
SEQ
out.repeat (' ', field - length, out!)
out.repeat (' ', field - length, out)
SEQ i = 0 FOR length
out ! s[i]
--}}}
:
--}}}
--{{{ PROC out.int (VAL INT n, VAL INT field, CHAN BYTE out)
--{{{ PROC out.int (VAL INT n, VAL INT field, CHAN OF BYTE out)
--* Write an integer in decimal to a channel.
-- This outputs [@code n] in a fieldwidth [@code field] down [@code out]. The
-- rules for fieldwidth are as [@ref out.byte].
-- @param n Integer
-- @param field Field width to right-justify in
-- @param out Channel to write to
PROC out.int (VAL INT n, VAL INT field, CHAN BYTE out)
PROC out.int (VAL INT n, VAL INT field, CHAN OF BYTE out)
--{{{
IF
n = (MOSTNEG INT)
--{{{ minint
out.string ("-2147483648", field, out!)
out.string ("-2147483648", field, out)
--}}}
n = 0
--{{{ zero
SEQ
IF
1 < field
out.repeat (' ', field - 1, out!)
out.repeat (' ', field - 1, out)
TRUE
SKIP
out ! '0'
@ -84,10 +84,10 @@ PROC out.int (VAL INT n, VAL INT field, CHAN BYTE out)
--{{{ pad
IF
n > 0
out.repeat (' ', field - i, out!)
out.repeat (' ', field - i, out)
TRUE
SEQ
out.repeat (' ', (field - 1) - i, out!)
out.repeat (' ', (field - 1) - i, out)
out ! '-'
--}}}
--{{{ output