X-Git-Url: https://git.hcoop.net/clinton/domtool2.git/blobdiff_plain/6bb366c5a60247419dce5cbce4a5c034fa2f1e5c..a49a9bfbe03214c68d029fe856a56006267bc8a3:/src/openssl.sml

diff --git a/src/openssl.sml b/src/openssl.sml
index 7a062f1..9ebb959 100644
--- a/src/openssl.sml
+++ b/src/openssl.sml
@@ -45,16 +45,16 @@ fun ssl_err s =
 	else
 	    (print (ZString.toML lib);
 	     print ":");
-	if C.Ptr.isNull func then
-	    ()
-	else
-	    (print (ZString.toML func);
-	     print ":");
-	if C.Ptr.isNull reason then
-	    ()
-	else
-	    print (ZString.toML reason);
-	print "\n"
+	    if C.Ptr.isNull func then
+		()
+	    else
+		(print (ZString.toML func);
+		 print ":");
+		if C.Ptr.isNull reason then
+		    ()
+		else
+		    print (ZString.toML reason);
+		print "\n"
     end
 
 val readBuf : (C.uchar, C.rw) C.obj C.ptr' = C.alloc' C.S.uchar (Word.fromInt Config.bufSize)
@@ -78,10 +78,12 @@ fun readChar bio =
 	    (ssl_err "BIO_read";
 	     raise OpenSSL "BIO_read failed")
 	else
-	    SOME (chr (Word32.toInt (C.Get.uchar'
-					 (C.Ptr.sub' C.S.uchar (readBuf, 0)))))
+	    SOME (chr (Compat.Char.toInt (C.Get.uchar'
+					      (C.Ptr.sub' C.S.uchar (readBuf, 0)))))
     end
 
+val charToWord = Word32.fromLargeWord o Compat.Char.toLargeWord
+
 fun readInt bio =
     let
 	val r = F_OpenSSL_SML_read.f' (bio, C.Ptr.inject' readBuf, four)
@@ -94,14 +96,14 @@ fun readInt bio =
 	else
 	    SOME (Word32.toInt
 		      (Word32.+
-		       (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 0)),
+		       (charToWord (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 0))),
 			Word32.+
-			(Word32.<< (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 1)),
+			(Word32.<< (charToWord (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 1))),
 				    eight),
 			 Word32.+
-			 (Word32.<< (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 2)),
+			 (Word32.<< (charToWord (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 2))),
 				     sixteen),
-			  Word32.<< (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 3)),
+			  Word32.<< (charToWord (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 3))),
 				     twentyfour))))))
     end
 
@@ -131,8 +133,8 @@ fun readLen (bio, len) =
 		     raise OpenSSL "BIO_read failed")
 		else if r = needed then
 		    SOME (CharVector.tabulate (Int32.toInt needed,
-					    fn i => chr (Word32.toInt (C.Get.uchar'
-									   (C.Ptr.sub' C.S.uchar (buf, i))))))
+					       fn i => chr (Compat.Char.toInt (C.Get.uchar'
+										   (C.Ptr.sub' C.S.uchar (buf, i))))))
 		else
 		    loop (C.Ptr.|+! C.S.uchar (buf', Int32.toInt r), needed - r)
 	    end
@@ -152,8 +154,8 @@ fun readChunk bio =
 	     raise OpenSSL "BIO_read failed")
 	else
 	    SOME (CharVector.tabulate (Int32.toInt r,
-				    fn i => chr (Word32.toInt (C.Get.uchar'
-								   (C.Ptr.sub' C.S.uchar (readBuf, i))))))
+				       fn i => chr (Compat.Char.toInt (C.Get.uchar'
+									   (C.Ptr.sub' C.S.uchar (readBuf, i))))))
     end
 
 fun readString bio =
@@ -164,7 +166,7 @@ fun readString bio =
 fun writeChar (bio, ch) =
     let
 	val _ = C.Set.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 0),
-			      Word32.fromInt (ord ch))
+			      Compat.Char.fromInt (ord ch))
 
 	fun trier () =
 	    let
@@ -182,18 +184,20 @@ fun writeChar (bio, ch) =
 	trier ()
     end
 
+val wordToChar = Compat.Char.fromLargeWord o Word32.toLargeWord
+
 fun writeInt (bio, n) =
     let
 	val w = Word32.fromInt n
 
 	val _ = (C.Set.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 0),
-			       Word32.andb (w, mask1));
+			       wordToChar (Word32.andb (w, mask1)));
 		 C.Set.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 1),
-			       Word32.andb (Word32.>> (w, eight), mask1));
+			       wordToChar (Word32.andb (Word32.>> (w, eight), mask1)));
 		 C.Set.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 2),
-			       Word32.andb (Word32.>> (w, sixteen), mask1));
+			       wordToChar (Word32.andb (Word32.>> (w, sixteen), mask1)));
 		 C.Set.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 3),
-			       Word32.andb (Word32.>> (w, twentyfour), mask1)))
+			       wordToChar (Word32.andb (Word32.>> (w, twentyfour), mask1))))
 
 	fun trier (buf, count) =
 	    let