[Git][ghc/ghc][wip/js-staging] 4 commits: Fix comment
Sylvain Henry (@hsyl20)
gitlab at gitlab.haskell.org
Tue Oct 18 14:57:42 UTC 2022
Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC
Commits:
32a70839 by Sylvain Henry at 2022-10-18T17:01:12+02:00
Fix comment
- - - - -
6f740c83 by Sylvain Henry at 2022-10-18T17:01:12+02:00
More bound checking
- - - - -
313a40e8 by Sylvain Henry at 2022-10-18T17:01:12+02:00
Fix some Word reading in Prim
- - - - -
0e255a2b by Sylvain Henry at 2022-10-18T17:01:12+02:00
Implement openDir
Seems to work (with tracing) but tests still fail with getInt16 index
error :'(
- - - - -
3 changed files:
- compiler/GHC/Driver/Backend.hs
- compiler/GHC/StgToJS/Prim.hs
- libraries/base/jsbits/base.js
Changes:
=====================================
compiler/GHC/Driver/Backend.hs
=====================================
@@ -216,7 +216,7 @@ platformNcgSupported platform = if
ArchAArch64 -> True
_ -> False
--- | Is the platform supported by the Native Code Generator?
+-- | Is the platform supported by the JS backend?
platformJSSupported :: Platform -> Bool
platformJSSupported platform
| platformArch platform == ArchJavaScript = True
=====================================
compiler/GHC/StgToJS/Prim.hs
=====================================
@@ -828,11 +828,11 @@ genPrim prof bound ty op = case op of
]
ReadOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_u8 a (off8 o i)
ReadOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_u16 a (off16 o i)
- ReadOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_i32 a (off32 o i)
+ ReadOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_u32 a (off32 o i)
ReadOffAddrOp_Word64 -> \[c1,c2] [a,o,i] ->
PrimInline $ mconcat
- [ c1 |= read_boff_i32 a (Add (off64 o i) (Int 4))
- , c2 |= read_boff_i32 a (off64 o i)
+ [ c1 |= read_boff_u32 a (Add (off64 o i) (Int 4))
+ , c2 |= read_boff_u32 a (off64 o i)
]
WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v
WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v
@@ -1036,8 +1036,8 @@ genPrim prof bound ty op = case op of
TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len]
TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo]
- IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i
- IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_i32 a i
+ IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i
+ IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i
IndexByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] ->
PrimInline $ jVar \x -> mconcat
[ x |= i .<<. two_
@@ -1048,32 +1048,32 @@ genPrim prof bound ty op = case op of
])
(mconcat [r1 |= null_, r2 |= one_])
]
- IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_f32 a i
- IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_f64 a i
+ IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i
+ IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i
IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] ->
PrimInline $ mconcat
[ r1 |= var "h$stablePtrBuf"
, r2 |= read_boff_i32 a i
]
- IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_i16 a i
- IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_i32 a i
+ IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i
+ IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i
IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] ->
PrimInline $ mconcat
[ h |= read_boff_i32 a (Add i (Int 4))
, l |= read_boff_u32 a i
]
- IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_i32 a i
- IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u16 a i
- IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u32 a i
+ IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i
+ IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i
+ IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i
IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] ->
- PrimInline $ mconcat
+ PrimInline . boundsChecked bound a (Add i 7) $ mconcat
[ h |= read_boff_u32 a (Add i (Int 4))
, l |= read_boff_u32 a i
]
- IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u32 a i
+ IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i
- ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i
- ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_i32 a i
+ ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i
+ ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i
ReadByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] ->
PrimInline $ jVar \x -> mconcat
[ x |= i .<<. two_
@@ -1084,32 +1084,32 @@ genPrim prof bound ty op = case op of
])
(mconcat [r1 |= null_, r2 |= one_])
]
- ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_f32 a i
- ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_f64 a i
+ ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i
+ ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i
ReadByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] ->
PrimInline $ mconcat
[ r1 |= var "h$stablePtrBuf"
, r2 |= read_boff_i32 a i
]
- ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_i16 a i
- ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_i32 a i
+ ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i
+ ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i
ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] ->
PrimInline $ mconcat
[ h |= read_boff_i32 a (Add i (Int 4))
, l |= read_boff_u32 a i
]
- ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_i32 a i
- ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u16 a i
- ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u32 a i
+ ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i
+ ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i
+ ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i
ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] ->
- PrimInline $ mconcat
+ PrimInline . boundsChecked bound a (Add i 7) $ mconcat
[ h |= read_boff_u32 a (Add i (Int 4))
, l |= read_boff_u32 a i
]
- ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u32 a i
+ ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i
- WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i8 a i e
- WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i32 a i e
+ WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i8 a i e
+ WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e
WriteByteArrayOp_Word8AsAddr -> \[] [a,i,e1,e2] ->
PrimInline $ mconcat
[ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty
@@ -1117,11 +1117,11 @@ genPrim prof bound ty op = case op of
a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2])
]
- WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_f32 a i e
- WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_f64 a i e
- WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a i $ write_boff_i32 a i e2
- WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i16 a i e
- WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i32 a i e
+ WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_f32 a i e
+ WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_boff_f64 a i e
+ WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e2
+ WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_i16 a i e
+ WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e
WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] ->
-- JS Numbers are little-endian and 32-bit, so write the lower 4 bytes at i
-- then write the higher 4 bytes to i+4
@@ -1129,20 +1129,20 @@ genPrim prof bound ty op = case op of
$ mconcat [ write_boff_i32 a (Add i (Int 4)) h
, write_boff_u32 a i l
]
- WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i32 a i e
- WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_u16 a i e
- WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_u32 a i e
+ WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e
+ WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_u16 a i e
+ WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e
WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] ->
- PrimInline . boundsChecked bound a i
+ PrimInline . boundsChecked bound a (Add i 7)
$ mconcat [ write_boff_u32 a (Add i (Int 4)) h
, write_boff_u32 a i l
]
- WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_u32 a i e
+ WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e
- CasByteArrayOp_Int -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i32 write_i32 r a i old new
- CasByteArrayOp_Int8 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i8 write_i8 r a i old new
- CasByteArrayOp_Int16 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i16 write_i16 r a i old new
- CasByteArrayOp_Int32 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i32 write_i32 r a i old new
+ CasByteArrayOp_Int -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new
+ CasByteArrayOp_Int8 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i8 write_i8 r a i old new
+ CasByteArrayOp_Int16 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 1) $ casOp read_i16 write_i16 r a i old new
+ CasByteArrayOp_Int32 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new
CasByteArrayOp_Int64 -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsChecked bound a (Add (i .<<. one_) one_) $
jVar \t_h t_l -> mconcat [ t_h |= read_i32 a (Add (i .<<. one_) one_)
=====================================
libraries/base/jsbits/base.js
=====================================
@@ -786,3 +786,54 @@ function h$putchar(c) {
h$base_write(1, h$putchar_buf, 0, 1, null);
return h$errno;
}
+
+function h$__hscore_set_errno(n) {
+ h$errno = n;
+}
+
+/*******************************************
+ * Directory API
+ *******************************************/
+
+function h$opendir(path) {
+ if(!h$isNode()) {
+ throw "h$opendir unsupported";
+ }
+
+ const d = fs.opendirSync(h$decodeUtf8z(path,0));
+ RETURN_UBX_TUP2(d,0);
+}
+
+function h$closedir(d,o) {
+ if(!h$isNode()) {
+ throw "h$closedir unsupported";
+ }
+ d.closeSync();
+ return 0;
+}
+
+function h$readdir(d,o) {
+ if(!h$isNode()) {
+ throw "h$readdir unsupported";
+ }
+ const c = d.readSync();
+ RETURN_UBX_TUP2(c,0);
+}
+
+function h$__hscore_readdir(d,o,dst_a,dst_o) {
+ if(!h$isNode()) {
+ throw "h$readdir unsupported";
+ }
+ const e = d.readSync();
+
+ if (!dst_a.arr) dst_a.arr = [];
+ dst_a.arr[dst_o*2] = [e,0];
+ return 0;
+}
+
+function h$__hscore_free_dirent(a,o) {
+}
+
+function h$__hscore_d_name(a,o) {
+ RETURN_UBX_TUP2(h$encodeModifiedUtf8(a.name),0);
+}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/20206973692658de70bb6c8525a794b24f1c442f...0e255a2b0e0ab80d0e71ee87561d07830b68d0ec
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/20206973692658de70bb6c8525a794b24f1c442f...0e255a2b0e0ab80d0e71ee87561d07830b68d0ec
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20221018/c8b4d934/attachment-0001.html>
More information about the ghc-commits
mailing list