Gcode is imported by: GcodeFix, GcodeLow, GcodeLowC, GcodeMem, GcodeOpt1, GcodeOpt2, GcodeRel, GcodeSpec, Main, STGBuild, STGGcode, STGState.
module Gcode ( GALT(..),Gcode(..),showCLabel,strGcode,strGcodeRel , IntState, Prim(..), PrimOp(..),Pos(..)) where import Prim(Prim(..),PrimOp(..),strPrim) import IntState(tidIS,strIS,IntState) import TokenId(TokenId,dropM) import Extra(Pos(..)) data GALT = GALT_CON Int | GALT_INT Int deriving (Eq) data Gcode = STARTFUN Pos Int -- Id | NEEDHEAP Int | NEEDSTACK Int | LABEL Int | LOCAL String Int | GLOBAL String Int | JUMP Int | JUMPFALSE Int -- DAVID | PRIMITIVE | CASE [(GALT,Int)] (Maybe (Int,Int)) -- alt and maybe default | PRIM Prim | NOP | TABLESWITCH Int Int [Int] -- size, pad, labels DAVID | LOOKUPSWITCH Int Int [(Int,Int)] Int -- size, pad, [(tag,label)] def DAVID | MKIORETURN -- for FFI, added by MW
{---------------- DAVID ------------------
| MATCHCON -- set matchreg to constructor of value on top of stack
| MATCHINT -- set matchreg to int on top of stack
| JUMPS_T
| JUMPTABLE Int -- label 2 bytes
| JUMPS_L
| JUMPLENGTH Int Int -- size default
| JUMPLIST Int Int -- if matchreg == first int jump to label in second int
----------------- DAVID -------------------}
| ZAP_STACK Int | ZAP_ARG Int -- Stack | PUSH_CADR Int | PUSH_CVAL Int | PUSH_INT Int | PUSH_CHAR Int | PUSH_INTEGER Integer | PUSH_FLOAT Float | PUSH_DOUBLE Double | PUSH_STRING String | PUSH_ARG Int -- arg(1..) | PUSH_ZAP_ARG Int -- arg(1..) | PUSH Int -- stackoffset(0..) | PUSH_HEAP | PUSH_GLB String Int | POP Int -- size | SLIDE Int -- remove | UNPACK Int -- selector functions | SELECTOR_EVAL -- push the first (and only) argument and evaluate is | SELECT Int -- TOS is a constructor, replace it with it's i:th argument -- evaluation | APPLY Int -- extra arguments on the stack (1..) | EVAL | EVALUATED -- message from FixGcode to GcodeOp1 that tos i evaluated | RETURN | RETURN_EVAL -- Heap | HEAP_CADR Int | HEAP_CVAL Int | HEAP_INT Int | HEAP_CHAR Int | HEAP_INTEGER Integer | HEAP_FLOAT Float | HEAP_DOUBLE Double | HEAP_STRING String | HEAP_ARG Int -- arg(1..) | HEAP_ARG_ARG Int Int-- arg(1..) arg(1..) | HEAP_ARG_ARG_RET_EVAL Int Int-- arg(1..) arg(1..) then RETURN_EVAL | HEAP Int -- stackoffset(0..) | HEAP_GLB String Int | HEAP_CON Int -- ident | HEAP_VAP Int -- ident | HEAP_CAP Int Int -- ident size | HEAP_OFF Int -- hpoffset | HEAP_STATIC Int Int -- Producer Construction (Module and Type is easy to get later) | HEAP_CREATE -- Initiate dynamic | HEAP_SPACE -- empty word, used for retainer and enumeration fields | ALIGN -- pointer | ALIGN_CONST -- double | DATA_CREATE | DATA_CAPITEM Int Int -- little endian | DATA_CONSTHEADER Int Int | DATA_W Int | DATA_S String | DATA_F Float | DATA_D Double | DATA_NOP -- does not generate anything, used after DATA_D to keep 1 DATA/WORD | DATA_CLABEL Int -- call primitive C function | DATA_FLABEL Int -- call foreign imported function | DATA_GLB String Int | DATA_VAP Int | DATA_CAP Int Int | DATA_CON Int Int -- size cno | DATA_CONR Int Int -- size cno (an R-node) | DATA_CONT Int Int -- size cno (a Trace-node) | DATA_CONW Int Int -- size extra | DATA_CONP Int Int -- size extra deriving (Eq) showsL l s = "L_" ++ shows l s showsR l s = shows l s strGcode state g = strGcodePrim showsL state g strGcodeRel state g = strGcodePrim showsR state g strGcodePrim sL state (STARTFUN pos i) = "STARTFUN " ++ shows i "(" ++ strIS state i ++ ")\n" strGcodePrim sL state (NEEDHEAP i) = " NEEDHEAP " ++ shows i "\n" strGcodePrim sL state (NEEDSTACK i) = " NEEDSTACK " ++ shows i "\n" strGcodePrim sL state (LABEL i) = showsL i ":\n" strGcodePrim sL state (LOCAL s i) = s++strIS state i ++ ":\n" strGcodePrim sL state (GLOBAL s i) = let str = s++strIS state i in " EXPORT " ++ str ++ "\n" ++ str ++ ":\n" strGcodePrim sL state (JUMP i) = " JUMP " ++ sL i "\n" strGcodePrim sL state (JUMPFALSE i) = " JUMPFALSE " ++ sL i "\n" strGcodePrim sL state (PRIMITIVE) = " PRIMITIVE\n" strGcodePrim sL state (PRIM prim) = " " ++ strPrim prim ++ "\n" strGcodePrim sL state (CASE alts def) = " CASE\n" ++ concatMap (strGalt state) alts ++ (case def of Just (def,pop) -> " _ => " ++ sL def " (pop " ++ shows pop ")" Nothing -> "") ++ "\n" strGcodePrim sL state (NOP) = " NOP\n" strGcodePrim sL state (TABLESWITCH size pad ls) = -- DAVID " TABLESWITCH " ++ show size ++ " " ++ show pad ++ " { " ++ foldr (\i s -> sL i (' ' : s)) "}\n" ls strGcodePrim sL state (LOOKUPSWITCH size pad tls def) = -- DAVID " LOOKUPSWITCH " ++ show size ++ " " ++ show pad ++ " { " ++ foldr (\(t,i) s -> '(' : show t ++ "," ++ sL i (") " ++ s)) (show def ++ "}\n") tls strGcodePrim sL state (MKIORETURN) = " MKIORETURN\n" -- MW
{------------ DAVID ----------------
strGcodePrim sL state (MATCHCON) = " MATCHCON\n"
strGcodePrim sL state (MATCHINT) = " MATCHINT\n"
strGcodePrim sL state (JUMPS_T) = " JUMPS_T\n"
strGcodePrim sL state (JUMPTABLE l) = " JUMPTABLE " ++ sL l "\n"
strGcodePrim sL state (JUMPS_L) = " JUMPS_L\n"
strGcodePrim sL state (JUMPLENGTH s l) = " JUMPLENGTH " ++ shows s ( " def " ++ sL l "\n")
strGcodePrim sL state (JUMPLIST v l) = " JUMPLIST con:" ++ shows v ( " => " ++ sL l "\n")
------------ DAVID -------------- -}
strGcodePrim sL state (ZAP_STACK i) = " ZAP_STACK " ++ shows i "\n" strGcodePrim sL state (ZAP_ARG i) = " ZAP_ARG " ++ shows i "\n" -- Stack strGcodePrim sL state (PUSH_CADR i) = " PUSH_CADR " ++ shows i "\n" strGcodePrim sL state (PUSH_CVAL i) = " PUSH_CVAL " ++ shows i "\n" strGcodePrim sL state (PUSH_INT i) = " PUSH_INT " ++ shows i "\n" strGcodePrim sL state (PUSH_CHAR i) = " PUSH_CHAR " ++ shows i "\n" strGcodePrim sL state (PUSH_STRING i) = " PUSH_STRING " ++ shows i "\n" strGcodePrim sL state (PUSH_INTEGER i)= " PUSH_INTEGER " ++ shows i "\n" strGcodePrim sL state (PUSH_FLOAT i) = " PUSH_FLOAT " ++ shows i "\n" strGcodePrim sL state (PUSH_DOUBLE i) = " PUSH_DOUBLE " ++ shows i "\n" strGcodePrim sL state (PUSH_ARG i) = " PUSH_ARG " ++ shows i "\n" strGcodePrim sL state (PUSH_ZAP_ARG i) = " PUSH_ZAP_ARG " ++ shows i "\n" strGcodePrim sL state (PUSH i) = " PUSH " ++ shows i "\n" strGcodePrim sL state (PUSH_HEAP) = " PUSH_HEAP\n" strGcodePrim sL state (PUSH_GLB s i) = " PUSH_GLB " ++ s ++ strIS state i ++ " (" ++ shows i ")\n" strGcodePrim sL state (POP i) = " POP " ++ shows i "\n" strGcodePrim sL state (SLIDE i) = " SLIDE " ++ shows i "\n" strGcodePrim sL state (UNPACK i) = " UNPACK " ++ shows i "\n" -- selector strGcodePrim sL state (SELECTOR_EVAL) = " SELECTOR_EVAL\n" strGcodePrim sL state (SELECT i) = " SELECT " ++ shows i "\n" -- evaluation strGcodePrim sL state (APPLY i) = " APPLY " ++ shows i "\n" strGcodePrim sL state (EVAL) = " EVAL\n" strGcodePrim sL state (EVALUATED) = " EVALUATED\n" strGcodePrim sL state (RETURN) = " RETURN\n" strGcodePrim sL state (RETURN_EVAL) = " RETURN_EVAL\n" -- Heap strGcodePrim sL state (HEAP_CADR i) = " HEAP_CADR " ++ shows i "\n" strGcodePrim sL state (HEAP_CVAL i) = " HEAP_CVAL " ++ shows i "\n" strGcodePrim sL state (HEAP_INT i) = " HEAP_INT " ++ shows i "\n" strGcodePrim sL state (HEAP_CHAR i) = " HEAP_CHAR " ++ shows i "\n" strGcodePrim sL state (HEAP_STRING i) = " HEAP_STRING " ++ shows i "\n" strGcodePrim sL state (HEAP_INTEGER i)= " HEAP_INTEGER " ++ shows i "\n" strGcodePrim sL state (HEAP_FLOAT i) = " HEAP_FLOAT " ++ shows i "\n" strGcodePrim sL state (HEAP_DOUBLE i) = " HEAP_DOUBLE " ++ shows i "\n" strGcodePrim sL state (HEAP_ARG i) = " HEAP_ARG " ++ shows i "\n" strGcodePrim sL state (HEAP_ARG_ARG i j)=" HEAP_ARG_ARG " ++ shows i " " ++ shows j "\n" strGcodePrim sL state (HEAP_ARG_ARG_RET_EVAL i j)=" HEAP_ARG_ARG_RET_EVAL " ++ shows i " " ++ shows j "\n" strGcodePrim sL state (HEAP i) = " HEAP " ++ shows i "\n" strGcodePrim sL state (HEAP_GLB s i) = " HEAP_GLB " ++ s ++ strIS state i ++ " (" ++ shows i ")\n" strGcodePrim sL state (HEAP_CON i) = " HEAP_CON " ++ shows i (" (" ++ strIS state i ++ ")\n") strGcodePrim sL state (HEAP_VAP i) = " HEAP_VAP " ++ shows i (" (" ++ strIS state i ++ ")\n") strGcodePrim sL state (HEAP_CAP i s) = " HEAP_CAP " ++ strIS state i ++ ":" ++ shows s (" (" ++ shows i ")\n" ) strGcodePrim sL state (HEAP_OFF i) = " HEAP_OFF " ++ shows i "\n" strGcodePrim sL state (HEAP_STATIC p c) = " HEAP_STATIC " ++ strIS state p ++ " " ++ strIS state c ++ "\n" strGcodePrim sL state (HEAP_CREATE) = " HEAP_CREATE\n" strGcodePrim sL state (HEAP_SPACE) = " HEAP_SPACE\n" strGcodePrim sL state (DATA_CREATE) = " DATA_CREATE\n" strGcodePrim sL state (DATA_CAPITEM a b) = " DATA_CAPITEM " ++ shows a (' ':shows b "\n") strGcodePrim sL state (DATA_CONSTHEADER a b) = " DATA_CONSTHEADER " ++ shows a (' ':shows b "\n") strGcodePrim sL state (DATA_W i) = " DATA_W " ++ shows i "\n" strGcodePrim sL state (DATA_F f) = " DATA_F " ++ shows f "\n" strGcodePrim sL state (DATA_S s) = " DATA_S " ++ shows s "\n" strGcodePrim sL state (DATA_D d) = " DATA_D " ++ shows d "\n" strGcodePrim sL state (DATA_NOP) = " DATA_NOP\n" strGcodePrim sL state (DATA_CLABEL i) = " DATA_CLABEL " ++ showCLabel state i ( " (" ++ shows i ")\n") strGcodePrim sL state (DATA_FLABEL i) = " DATA_FLABEL " ++ showCLabel state i ( " (" ++ shows i ")\n") strGcodePrim sL state (DATA_GLB s i) = " DATA_GLB " ++ s ++ strIS state i ++ " (" ++ shows i ")\n" strGcodePrim sL state (DATA_VAP i) = " DATA_VAP " ++ shows i "(" ++ strIS state i ++ ")\n" strGcodePrim sL state (DATA_CAP i s) = " DATA_CAP " ++ strIS state i ++ ":" ++ shows s (" (" ++ shows i ")\n" ) strGcodePrim sL state (DATA_CON s c) = " DATA_CON " ++ shows s (' ':shows c "\n") strGcodePrim sL state (DATA_CONR s c) = " DATA_CONR " ++ shows s (' ':shows c "\n") strGcodePrim sL state (DATA_CONT s c) = " DATA_CONT " ++ shows s (' ':shows c "\n") strGcodePrim sL state (DATA_CONW s e) = " DATA_CONW " ++ shows s (' ':shows e "\n") strGcodePrim sL state (DATA_CONP s e) = " DATA_CONP " ++ shows s (' ':shows e "\n") strGcodePrim sL state (ALIGN) = "\n\n ALIGN\n" strGcodePrim sL state (ALIGN_CONST) = "\n\n ALIGN_CONST\n" strGalt state (GALT_CON i,l) = " " ++ shows i " (" ++ strIS state i ++ ")=> " ++ showsL l "\n" strGalt state (GALT_INT i,l) = " " ++ shows i " => " ++ showsL l "\n" showCLabel state i = shows (dropM (tidIS state i))
(HTML for this module was generated on May 15, 2003. About the conversion tool.)