( ************************************************* ) ( * DOUBLE PRECISION FORMATTED OUTPUT ROUTINES. * ) ( * FILE SHARPS.4TH APRIL 25, 1981 * ) ( * THESE PROGRAMS ARE MODELED AFTER THE FIG-FORTH* ) ( * ROUTINES THAT PERFORM THE SAME FUNCTION. * ) ( ************************************************* ) 30 ( SIZE OF STRING BUFFER CONTAINING THE NUMBER) DUP BLOCK #BUFFER ( STRING BUFFER) '' #BUFFER + CONST #ENDBUF ( ADDRESS OF END ) 2 BLOCK #INPOINT ( INPUT POINTER) 1 BLOCK #SIGN ( SIGN FLAG) : #PUTBYTE ( PUT THE BYTE AT TOS IN THE BUFFER) #INPOINT @ 1 - ( NEW INPUT POINTER) DUP #BUFFER = IF ( DO WE HAVE OVERFLOW?) #ENDBUF 1 - SWAP DO "*" I B! LOOP ( FILL BUFFER WITH STARS.) DROP ( DISCARD THE CHARACTER) ELSE ( IF NO OVERFLOW, UPDATE POINTER AND STORE CHAR.) DUP #INPOINT ! B! THEN ; ( END OF #PUTBYTE.) : <# ( BEGIN A FORMAT OPERATION) #ENDBUF #INPOINT ! ( INPUT POINTER IS PAST END OF BUFFER.) ,DUP ,0 ,< IF ( TEST THE SIGN OF THE NUMBER) ,-1* ( NEGATE THE NUMBER) 1 ( SIGN=1) ELSE 0 ( SIGN=0) THEN #SIGN B! ( SAVE THE SIGN) ; ( END OF <# ) : # ( CONVERT ONE DIGIT INTO THE BUFFER) ,10 ,/MOD ,SWAP SINGLE ( CONVERT THE DIGIT) "0" + ( MAKE IT ASCII) #PUTBYTE ( PUT IT IN THE BUFFER) ; ( END OF # ) : #S ( CONVERT THE DIGITS UNTIL ,TOS IS ZERO) BEGIN ( DO UNTIL TOS=0 ) # ( CONVERT A DIGIT) ,DUP ,0= ( TEST TOS) END ; ( END OF #S ) : #. ( PUT IN A DECIMAL POINT AND CONVERT THE REST OF THE DIGITS) "." #PUTBYTE #S ; ( END OF #. ) : #- ( PUT IN AN OPTIONAL SIGN FIELD ) #SIGN B@ IF "-" #PUTBYTE THEN ; : #+ ( PUT IN A REQUIRED SIGN FIELD ) #SIGN B@ IF "-" ELSE "+" THEN #PUTBYTE ; : #> ( TERMINATE THE FORMATTING OPERATION, RETURN THE ADDR.) ( OF THE BEGINNING OF THE STRING REPRESENTING THE ) ( FIELD. ON ENTRY, TOS=THE FIELD WIDTH, ,NOS IS ,0 ) #ENDBUF #INPOINT @ - 1 + ( CURRENT FIELD SIZE + 1.) DO ( NOTE: FIELD SIZE ) ( END OF FILE SHARPS )