(FILECREATED "12-Apr-85 19:07:08" {DSK}<LISPFILES>HTHOMPSON>TRUEHAX.;4 2650   

      changes to:  (FNS TrueRadixRead TrueRadixPrint TRP1 TRS)
		   (VARS TRUEHAXCOMS \TRSStream)

      previous date: " 5-Apr-85 20:16:37" {DSK}<LISPFILES>HTHOMPSON>TRUEHAX.;1)


(* Copyright (c) 1985 by Henry Thompson. All rights reserved.)

(PRETTYCOMPRINT TRUEHAXCOMS)

(RPAQQ TRUEHAXCOMS ((FNS TRP1 TRS TrueMod TrueRadixPrint TrueRadixRead)
		    (VARS (\TRSStream)
			  (\TRSString))
		    (GLOBALVARS \TRSStream \TRSString)))
(DEFINEQ

(TRP1
  [LAMBDA (N R F)                                            (* ht: "12-Apr-85 16:33")
    (if N~=0
	then (TRP1 (N-(TrueMod N R))/R R F)
	     (PRIN1 (let ((res (TrueMod N R)))
			 (if (GREATERP res 9)
			     then (CHARACTER 55+res)
			   else res))
		    F])

(TRS
  [LAMBDA (N R OLD)                                          (* ht: "12-Apr-85 16:25")
    (let [(f (OR \TRSStream (SETQ \TRSStream (OPENSTRINGSTREAM (SETQ \TRSString (ALLOCSTRING 100))
							       'BOTH]
	 (SETFILEPTR f 0)
	 (TrueRadixPrint N R f)
	 (SUBSTRING \TRSString 1 (GETFILEPTR f)
		    OLD])

(TrueMod
  [LAMBDA (X N)                                              (* ht: "24-Feb-85 13:53")
    (if (AND (ILESSP N 0)
	     (ILESSP X 0))
	then (if (IREMAINDER X N)=0
		 then 0
	       else (IREMAINDER X N)
		    -N)
      else (IMOD X N])

(TrueRadixPrint
  [LAMBDA (N R F)                                            (* ht: "12-Apr-85 16:18")
    (if N=0
	then (PRIN1 N F)
      elseif (AND (ILESSP N 0)
		  (IGREATERP R 0))
	then (PRIN1 '-
		    F)
	     (TRP1 (-N)
		   R F)
      else (TRP1 N R F])

(TrueRadixRead
  [LAMBDA (R F TAB)                                          (* ht: "12-Apr-85 19:04")
    (while (GETSYNTAX (PEEKC F)
		      TAB)= 'SEPRCHAR do (READC F TAB))
    (bind (r ← 0)
	  c cc mFlg first (if (PEEKC F)= '-
			      then (mFlg←T)
				   (READC F TAB))
       while [OR (NUMBERP c←(READC F TAB))
		 (PROGN cc←(CHCON1 c)
			- 55 (AND (IGREATERP cc 9)
				  (ILESSP cc R]
       do (r←(OR cc c)+r*R)
	  (cc←NIL)
       finally (RETURN (if mFlg
			   then (-r)
			 else r])
)

(RPAQQ \TRSStream NIL)

(RPAQQ \TRSString NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \TRSStream \TRSString)
)
(PUTPROPS TRUEHAX COPYRIGHT ("Henry Thompson" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (524 2447 (TRP1 534 . 856) (TRS 858 . 1214) (TrueMod 1216 . 1515) (TrueRadixPrint 1517
 . 1834) (TrueRadixRead 1836 . 2445)))))
STOP