X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=gen.icl;h=efa8fa3c9075523f0dcd432c2c40084cfb0e6a0e;hb=24472f94b2af1d2c01db24c4ddfe61143dda1459;hp=8981738217340008e75b6dfccb0728387a2537f0;hpb=53f1053727e36cb97e9670d1392c6e26848707a5;p=cc1516.git diff --git a/gen.icl b/gen.icl index 8981738..efa8fa3 100644 --- a/gen.icl +++ b/gen.icl @@ -40,10 +40,11 @@ labelStream :: [Label] labelStream = ["lbl_" +++ toString i\\i<-[1..]] defaultAddressBook :: Addressbook -defaultAddressBook = extend "print" (LAB "print") - $ extend "read" (LAB "read") - $ extend "isEmpty" (LAB "isEmpty") - 'Map'.newMap +defaultAddressBook = extend "1printint" (LAB "1printint") + $ extend "1printchar" (LAB "1printchar") + $ extend "1readchar" (LAB "1readchar") + $ extend "1readint" (LAB "1readint") + 'Map'.newMap gen :: AST -> Either String String gen (AST fds) = case evalRWST prog () (defaultAddressBook, labelStream) of @@ -57,14 +58,27 @@ gen (AST fds) = case evalRWST prog () (defaultAddressBook, labelStream) of >>| mapM_ g fds programContext :: SSMProgram -programContext = [Lab "print" //there is no actual IO in SSM +programContext = [Lab "1printint" ,Instr "link" [Lit 0] "" + ,Instr "ldl" [Lit -2] "load first argument" + ,Instr "trap" [Lit 0] "print int" ,Instr "unlink" [] "" ,Instr "ret" [] "" - ,Lab "read" //there is no actual IO in SSM + ,Lab "1printchar" ,Instr "link" [Lit 0] "" - ,Instr "ldc" [Lit 0] "" - ,Instr "sth" [] "" + ,Instr "ldl" [Lit -2] "load first argument" + ,Instr "trap" [Lit 1] "print char" + ,Instr "unlink" [] "" + ,Instr "ret" [] "" + ,Lab "1readint" + ,Instr "link" [Lit 0] "" + ,Instr "trap" [Lit 10] "read int" + ,Instr "str" [Raw "RR"] "" + ,Instr "unlink" [] "" + ,Instr "ret" [] "" + ,Lab "1readchar" + ,Instr "link" [Lit 0] "" + ,Instr "trap" [Lit 11] "read char" ,Instr "str" [Raw "RR"] "" ,Instr "unlink" [] "" ,Instr "ret" [] "" @@ -182,10 +196,11 @@ instance g Stmt where Nothing = liftT (Left $ Error $ concat ["PANIC: ", k, " not found as var"]) Just (LAB t) = liftT (Left $ Error $ "PANIC: cannot assign to function") Just (ADDR t) = tell [Instr "stl" [Lit t] ""] - g (FunStmt k es) = mapM_ g es + g (FunStmt k es fs) = mapM_ g es >>| jump "bsr" k >>| mapM_ (const $ tell [Instr "ajs" [Lit -1] ""]) es //clean up args - >>| pure () + >>| mapM_ g fs + >>| pure () g (ReturnStmt Nothing) = tell [Instr "unlink" [] ""] >>| tell [Instr "ret" [] ""] g (ReturnStmt (Just e)) = g e