BSD 4 release
[unix-history] / usr / src / libc / stdio / doprnt.s
index 909641a..06f7405 100644 (file)
        # C library -- conversions
 
 .globl __doprnt
        # C library -- conversions
 
 .globl __doprnt
-.globl __strout
+.globl __flsbuf
 
 
+#define vbit 1
 #define flags r10
 #define flags r10
-#define literb 0
-#define liter 1
-#define ndfndb 0
-#define ndfnd 1
-#define ljustb 1
-#define ljust 2
-#define zfillb 2
-#define zfill 4
-#define precb 3
-#define prec 8
-#define psignb 4
-#define psign 16
-#define gflagb 5
-#define gflag 32
+#define ndfnd 0
+#define prec 1
+#define zfill 2
+#define minsgn 3
+#define plssgn 4
+#define numsgn 5
+#define caps 6
+#define blank 7
+#define gflag 8
+#define dpflag 9
 #define width r9
 #define ndigit r8
 #define width r9
 #define ndigit r8
+#define llafx r7
+#define lrafx r6
 #define fdesc -4(fp)
 #define exp -8(fp)
 #define fdesc -4(fp)
 #define exp -8(fp)
-#define sign -9(fp)
-       .set one,010                    # 1.0 in floating immediate
+#define sexp -12(fp)
+#define nchar -16(fp)
+#define sign -17(fp)
        .set ch.zer,'0                  # cpp doesn't like single appostrophes
 
        .set ch.zer,'0                  # cpp doesn't like single appostrophes
 
+       .align 2
+strtab:                # translate table for detecting null and percent
+       .byte   0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15
+       .byte   16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31
+       .byte   ' ,'!,'",'#,'$, 0,'&,'','(,'),'*,'+,',,'-,'.,'/
+       .byte   '0,'1,'2,'3,'4,'5,'6,'7,'8,'9,':,';,'<,'=,'>,'?
+       .byte   '@,'A,'B,'C,'D,'E,'F,'G,'H,'I,'J,'K,'L,'M,'N,'O
+       .byte   'P,'Q,'R,'S,'T,'U,'V,'W,'X,'Y,'Z,'[,'\,'],'^,'_
+       .byte   '`,'a,'b,'c,'d,'e,'f,'g,'h,'i,'j,'k,'l,'m,'n,'o
+       .byte   'p,'q,'r,'s,'t,'u,'v,'w,'x,'y,'z,'{,'|,'},'~,127
+       .byte   128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143
+       .byte   144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159
+       .byte   160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175
+       .byte   176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191
+       .byte   192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207
+       .byte   208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223
+       .byte   224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239
+       .byte   240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255
+
+strfoo:
+       clrl r4                                 # fix interrupt race
+       jbr strok                               # and try again
+strmore:
+       movzbl (r1)+,r2                 # one char
+       tstb (r3)[r2]                   # translate
+       jeql stresc2                    # bad guy in disguise (outbuf is full)
+strout2:               # enter here to force out r2; r0,r1 must be set
+       pushr $3                                # save input descriptor
+       pushl fdesc                             # FILE
+       pushl r2                                # the char
+       calls $2,__flsbuf               # please empty the buffer and handle 1 char
+       tstl r0                                 # successful?
+       jgeq strm1                              # yes
+       jbcs $31,nchar,strm1    # turn on sign bit of nchar to signify error
+strm1:
+       incl nchar                              # count the char
+       popr $3                                 # get input descriptor back
+strout:                        # enter via bsb with (r0,r1)=input descriptor
+       movab strtab,r3                 # table address
+       movq *fdesc,r4                  # output descriptor
+       jbs $31,r4,strfoo               # negative count is a no no
+strok:
+       addl2 r0,nchar                  # we intend to move this many chars
+       movtuc r0,(r1),$0,(r3),r4,(r5)
+       movpsl r2                               # squirrel away condition codes
+       movq r4,*fdesc                  # update output descriptor
+       subl2 r0,nchar                  # some chars not moved
+       jbs $vbit,r2,stresc             # terminated by escape?
+       sobgeq r0,strmore               # no; but out buffer might be full
+stresc:
+       rsb
+stresc2:
+       incl r0                                 # fix the length
+       decl r1                                 # and the addr
+       movl $1<vbit,r2                 # fake condition codes
+       rsb
+
+errdone:
+       jbcs $31,nchar,prdone   # set error bit
+prdone:
+       movl nchar,r0
+       ret
+
        .align  1
 __doprnt:
        .word   0xfc0                   # uses r11-r6
        .align  1
 __doprnt:
        .word   0xfc0                   # uses r11-r6
-       subl2 $128,sp
+       movab -256(sp),sp               # work space
        movl 4(ap),r11                  # addr of format string
        movl 12(ap),fdesc               # output FILE ptr
        movl 8(ap),ap                   # addr of first arg
        movl 4(ap),r11                  # addr of format string
        movl 12(ap),fdesc               # output FILE ptr
        movl 8(ap),ap                   # addr of first arg
+       clrl nchar                              # number of chars transferred
 loop:
 loop:
-       movl r11,r0                     # current point in format
-       bicl2 $liter,flags              # no literal characters yet
-L1:    movb (r11)+,width               # next character of format
-       beql L2                         # end of format string
-       cmpb width,$'%
-       beql L2                         # warning character
-       bisl2 $liter,flags              # literal character
-       jbr L1
-L2:    blbc flags,L3                   # bbc $literb,flags,L3 # no literals in format
-       pushl fdesc                     # file pointer
-       pushl $0                        # no left/right adjust
-       pushl r0                        # addr
-       subl3 r0,r11,r1                 # length
-       subl3 $1,r1,-(sp)               # % or null not part of literal
-       calls $4,__strout               # dump the literal
-L3:
-       blbs width,L4                   # % is odd; end of format?
-       ret                             # yes
-
-       # htab overlaps last 16 characters of ftab
-ftab:  .byte    0, 0, 0,'c,'d,'e,'f,'g, 0, 0, 0,'+,'l,'-,'.,'o
-htab:  .byte   '0,'1,'2,'3,'4,'5,'6,'7,'8,'9,'a,'b,'c,'d,'e,'f
+       movzwl $65535,r0                # pseudo length
+       movl r11,r1                             # fmt addr
+       bsbw strout                             # copy to output, stop at null or percent
+       movl r1,r11                             # new fmt
+       jbc $vbit,r2,loop               # if no escape, then very long fmt
+       tstb (r11)+                             # escape; null or percent?
+       jeql prdone                             # null means end of fmt
 
 
-L4:    movl sp,r5                      # reset output buffer pointer
-       clrq r9                         # width; flags ljustb,ndfndb,zfillb
-L4a:   movzbl (r11)+,r0                # supposed format
-       extzv $0,$5,r0,r1                # bottom 5 bits
-L4b:   cmpb r0,ftab[r1]                # good enough?
-       jneq L6                         # no
-L4c:   casel r1,$3,$22                 # yes
-L5:    .word charac-L5                 # c
-       .word decimal-L5                # d
-       .word scien-L5                  # e
-       .word float-L5                  # f
-       .word general-L5                # g
-       .word L6-L5                     # h
-       .word L6-L5                     # i
-       .word L6-L5                     # j
+       movl sp,r5                      # reset output buffer pointer
+       clrq r9                         # width; flags
+       clrq r6                         # lrafx,llafx
+longorunsg:                            # we can ignore both of these distinctions
+short:
+L4a:
+       movzbl (r11)+,r0                # so capital letters can tail merge
+L4:    caseb r0,$' ,$'x-'              # format char
+L5:
+       .word space-L5                  # space
+       .word fmtbad-L5                 # !
+       .word fmtbad-L5                 # "
+       .word sharp-L5                  # #
+       .word fmtbad-L5                 # $
+       .word fmtbad-L5                 # %
+       .word fmtbad-L5                 # &
+       .word fmtbad-L5                 # '
+       .word fmtbad-L5                 # (
+       .word fmtbad-L5                 # )
+       .word indir-L5                  # *
        .word plus-L5                   # +
        .word plus-L5                   # +
-       .word longorunsg-L5             # l
+       .word fmtbad-L5                 # ,
        .word minus-L5                  # -
        .word dot-L5                    # .
        .word minus-L5                  # -
        .word dot-L5                    # .
-       .word octal-L5                  # o
+       .word fmtbad-L5                 # /
        .word gnum0-L5                  # 0
        .word gnum-L5                   # 1
        .word gnum-L5                   # 2
        .word gnum0-L5                  # 0
        .word gnum-L5                   # 1
        .word gnum-L5                   # 2
@@ -87,155 +141,292 @@ L5:      .word charac-L5                 # c
        .word gnum-L5                   # 7
        .word gnum-L5                   # 8
        .word gnum-L5                   # 9
        .word gnum-L5                   # 7
        .word gnum-L5                   # 8
        .word gnum-L5                   # 9
-
-L6:    jbcs $5,r0,L4b                  # capitals same as small
-       cmpb r0,$'s
-       jeql string
-       cmpb r0,$'x
-       jeql hex
-       cmpb r0,$'u
-       jeql unsigned
-       cmpb r0,$'r
-       jeql remote
-       movzbl -1(r11),r0               # orginal "format" character
-       cmpb r0,$'*
-       jeql indir
-L9:    movb r0,(r5)+                   # print the unfound character
+       .word fmtbad-L5                 # :
+       .word fmtbad-L5                 # ;
+       .word fmtbad-L5                 # <
+       .word fmtbad-L5                 # =
+       .word fmtbad-L5                 # >
+       .word fmtbad-L5                 # ?
+       .word fmtbad-L5                 # @
+       .word fmtbad-L5                 # A
+       .word fmtbad-L5                 # B
+       .word fmtbad-L5                 # C
+       .word decimal-L5                # D
+       .word capital-L5                # E
+       .word fmtbad-L5                 # F
+       .word capital-L5                # G
+       .word fmtbad-L5                 # H
+       .word fmtbad-L5                 # I
+       .word fmtbad-L5                 # J
+       .word fmtbad-L5                 # K
+       .word fmtbad-L5                 # L
+       .word fmtbad-L5                 # M
+       .word fmtbad-L5                 # N
+       .word octal-L5                  # O
+       .word fmtbad-L5                 # P
+       .word fmtbad-L5                 # Q
+       .word fmtbad-L5                 # R
+       .word fmtbad-L5                 # S
+       .word fmtbad-L5                 # T
+       .word unsigned-L5               # U
+       .word fmtbad-L5                 # V
+       .word fmtbad-L5                 # W
+       .word hex-L5                    # X
+       .word fmtbad-L5                 # Y
+       .word fmtbad-L5                 # Z
+       .word fmtbad-L5                 # [
+       .word fmtbad-L5                 # \
+       .word fmtbad-L5                 # ]
+       .word fmtbad-L5                 # ^
+       .word fmtbad-L5                 # _
+       .word fmtbad-L5                 # `
+       .word fmtbad-L5                 # a
+       .word fmtbad-L5                 # b
+       .word charac-L5                 # c
+       .word decimal-L5                # d
+       .word scien-L5                  # e
+       .word float-L5                  # f
+       .word general-L5                # g
+       .word short-L5                  # h
+       .word fmtbad-L5                 # i
+       .word fmtbad-L5                 # j
+       .word fmtbad-L5                 # k
+       .word longorunsg-L5             # l
+       .word fmtbad-L5                 # m
+       .word fmtbad-L5                 # n
+       .word octal-L5                  # o
+       .word fmtbad-L5                 # p
+       .word fmtbad-L5                 # q
+       .word fmtbad-L5                 # r
+       .word string-L5                 # s
+       .word fmtbad-L5                 # t
+       .word unsigned-L5               # u
+       .word fmtbad-L5                 # v
+       .word fmtbad-L5                 # w
+       .word hex-L5                    # x
+fmtbad:
+       movb r0,(r5)+                   # print the unfound character
+       jeql errdone                    # dumb users who end the format with a %
        jbr prbuf
        jbr prbuf
-
-nulstr:
-       .byte '(,'n,'u,'l,'l,'),0
+capital:
+       bisl2 $1<caps,flags             # note that it was capitalized
+       xorb2 $'a^'A,r0                 # make it small
+       jbr L4                                  # and try again
 
 string:
        movl ndigit,r0
 
 string:
        movl ndigit,r0
-       jbs $precb,flags,L20            # max length was specified
+       jbs $prec,flags,L20             # max length was specified
        mnegl $1,r0                     # default max length
 L20:   movl (ap)+,r2                   # addr first byte
        mnegl $1,r0                     # default max length
 L20:   movl (ap)+,r2                   # addr first byte
-       bneq L21
-       movab nulstr,r2
-L21:   locc $0,r0,(r2)                 # find the zero at the end
+       locc $0,r0,(r2)                 # find the zero at the end
        movl r1,r5                      # addr last byte +1
        movl r2,r1                      # addr first byte
        jbr prstr
 
        movl r1,r5                      # addr last byte +1
        movl r2,r1                      # addr first byte
        jbr prstr
 
+htab:  .byte   '0,'1,'2,'3,'4,'5,'6,'7,'8,'9,'a,'b,'c,'d,'e,'f
+Htab:  .byte   '0,'1,'2,'3,'4,'5,'6,'7,'8,'9,'A,'B,'C,'D,'E,'F
 
 
-longorunsg:
-       movb (r11)+,r0
-       cmpb r0,$'o
-       jeql loct
-       cmpb r0,$'x
-       jeql lhex
-       cmpb r0,$'d
-       jeql long
-       cmpb r0,$'u
-       jeql lunsigned
-       decl r11
-       jbr unsigned
-
-loct:
 octal:
        movl $30,r2                     # init position
        movl $3,r3                      # field width
 octal:
        movl $30,r2                     # init position
        movl $3,r3                      # field width
-       movl $10,r4                     # result length -1
+       movab htab,llafx        # translate table
        jbr L10
 
        jbr L10
 
-lhex:
 hex:
        movl $28,r2                     # init position
        movl $4,r3                      # field width
 hex:
        movl $28,r2                     # init position
        movl $4,r3                      # field width
-       movl $7,r4                      # result length -1
+       movab htab,llafx        # translate table
+       jbc $caps,flags,L10
+       movab Htab,llafx
 L10:   mnegl r3,r6                     # increment
        clrl r1
 L10:   mnegl r3,r6                     # increment
        clrl r1
+       addl2 $4,r5                     # room for left affix (2) and slop [forced sign?]
        movl (ap)+,r0                   # fetch arg
 L11:   extzv r2,r3,r0,r1               # pull out a digit
        movl (ap)+,r0                   # fetch arg
 L11:   extzv r2,r3,r0,r1               # pull out a digit
-       movb htab[r1],(r5)+             # convert to character
+       movb (llafx)[r1],(r5)+          # convert to character
 L12:   acbl $0,r6,r2,L11               # continue until done
 L12:   acbl $0,r6,r2,L11               # continue until done
+       clrq r6                         # lrafx, llafx
        clrb (r5)                       # flag end
        clrb (r5)                       # flag end
-       skpc $'0,r4,(sp)                # skip over leading zeroes
-       jbr prstr
+       skpc $'0,$11,4(sp)              # skip over leading zeroes
+       jbc $numsgn,flags,prn3  # easy if no left affix
+       tstl -4(ap)                             # original value
+       jeql prn3                       # no affix on 0, for some reason
+       cmpl r3,$4                      # were we doing hex or octal?
+       jneq L12a                       # octal
+       movb $'x,r0
+       jbc $caps,flags,L12b
+       movb $'X,r0
+L12b:  movb r0,-(r1)
+       movl $2,llafx           # leading 0x for hex is an affix
+L12a:  movb $'0,-(r1)  # leading zero for octal is a digit, not an affix
+       jbr prn3                        # omit sign (plus, blank) massaging
+
+unsigned:
+lunsigned:
+       bicl2 $1<plssgn|1<blank,flags   # omit sign (plus, blank) massaging
+       extzv $1,$31,(ap),r0            # right shift logical 1 bit
+       cvtlp r0,$10,(sp)               # convert [n/2] to packed
+       movp $10,(sp),8(sp)             # copy packed
+       addp4 $10,8(sp),$10,(sp)        # 2*[n/2] in packed, at (sp)
+       blbc (ap)+,L14                  # n was even
+       addp4 $1,pone,$10,(sp)          # n was odd
+       jbr L14
 
 patdec:                                        # editpc pattern for decimal printing
 
 patdec:                                        # editpc pattern for decimal printing
-       .byte 0xA9                      # eo$float 9
+       .byte 0xAA                      # eo$float 10
        .byte 0x01                      # eo$end_float
        .byte 0x01                      # eo$end_float
-       .byte 0x91                      # eo$move 1
        .byte 0                         # eo$end
 
        .byte 0                         # eo$end
 
-long:
 decimal:
        cvtlp (ap)+,$10,(sp)            # 10 digits max
 decimal:
        cvtlp (ap)+,$10,(sp)            # 10 digits max
+       jgeq L14
+       incl llafx                      # minus sign is a left affix
 L14:   editpc $10,(sp),patdec,8(sp)    # ascii at 8(sp); r5=end+1
 L14:   editpc $10,(sp),patdec,8(sp)    # ascii at 8(sp); r5=end+1
-       skpc $' ,$10,8(sp)              # skip leading blanks; r1=first
+       skpc $' ,$11,8(sp)              # skip leading blanks; r1=first
+
+prnum:                 # r1=addr first byte, r5=addr last byte +1, llafx=size of signs
+                               # -1(r1) vacant, for forced sign
+       tstl llafx
+       jneq prn3                       # already some left affix, dont fuss
+       jbc $plssgn,flags,prn2
+       movb $'+,-(r1)          # needs a plus sign
+       jbr prn4
+prn2:  jbc $blank,flags,prn3
+       movb $' ,-(r1)          # needs a blank sign
+prn4:  incl llafx
+prn3:  jbs $prec,flags,prn1
+       movl $1,ndigit          # default precision is 1
+prn1:  subl3 r1,r5,lrafx       # raw width
+       subl2 llafx,lrafx       # number of digits
+       subl2 lrafx,ndigit      # number of leading zeroes needed
+       jleq prstr                      # none
+       addl2 llafx,r1          # where current digits start
+       pushl r1                        # movcx gobbles registers
+               # check bounds on users who say %.300d
+       movab 32(r5)[ndigit],r2
+       subl2 fp,r2
+       jlss prn5
+       subl2 r2,ndigit
+prn5:
+               #
+       movc3 lrafx,(r1),(r1)[ndigit]   # make room in middle
+       movc5 $0,(r1),$ch.zer,ndigit,*(sp)      # '0 fill
+       subl3 llafx,(sp)+,r1    # first byte addr
+       addl3 lrafx,r3,r5       # last byte addr +1
 
 prstr:                 # r1=addr first byte; r5=addr last byte +1
 
 prstr:                 # r1=addr first byte; r5=addr last byte +1
-       cvtbl $' ,-(sp)                 # blank fill
-       jbc $zfillb,flags,L15
-       cvtbl $'0,(sp)                  # zero fill
-L15:   pushl fdesc                     # FILE
-       subl2 r1,r5                     # r5=actual length=end+1-first
-       subl3 r5,width,r0               # if >0, how much to fill
-       bgeq L24
-       clrl r0                         # no fill
-L24:   jbs $ljustb,flags,L25
-       mnegl r0,r0
-L25:   pushl r0                        # fill count
-       pushl r1                        # addr first byte
-       pushl r5                        # length
-       calls $5,__strout
-       jbr     loop
+                               # width=minimum width; llafx=len. left affix
+                               # ndigit=<avail>
+       subl3 r1,r5,ndigit              # raw width
+       subl3 ndigit,width,r0   # pad length
+       jleq padlno                             # in particular, no left padding
+       jbs $minsgn,flags,padlno
+                       # extension for %0 flag causing left zero padding to field width
+       jbs $zfill,flags,padlz
+                       # this bsbb needed even if %0 flag extension is removed
+       bsbb padb                               # blank pad on left
+       jbr padnlz
+padlz:
+       movl llafx,r0
+       jleq padnlx                             # left zero pad requires left affix first
+       subl2 r0,ndigit                 # part of total length will be transferred
+       subl2 r0,width                  # and will account for part of minimum width
+       bsbw strout                             # left affix
+padnlx:
+       subl3 ndigit,width,r0   # pad length
+       bsbb padz                               # zero pad on left
+padnlz:
+                       # end of extension for left zero padding
+padlno:                        # remaining: root, possible right padding
+       subl2 ndigit,width              # root reduces minimum width
+       movl ndigit,r0                  # root length
+p1:    bsbw strout                             # transfer to output buffer
+p3:    jbc $vbit,r2,padnpct    # percent sign (or null byte via %c) ?
+       decl r0                                 # yes; adjust count
+       movzbl (r1)+,r2                 # fetch byte
+       movq *fdesc,r4                  # output buffer descriptor
+       sobgeq r4,p2                    # room at the out [inn] ?
+       bsbw strout2                    # no; force it, then try rest
+       jbr p3                                  # here we go 'round the mullberry bush, ...
+p2:    movb r2,(r5)+                   # hand-deposit the percent or null
+       incl nchar                              # count it
+       movq r4,*fdesc                  # store output descriptor
+       jbr p1                                  # what an expensive hiccup!
+padnpct:
+       movl width,r0   # size of pad
+       jleq loop
+       bsbb padb
+       jbr loop
+
+padz:
+       movb $'0,r2
+       jbr pad
+padb:
+       movb $' ,r2
+pad:
+       subl2 r0,width                  # pad width decreases minimum width
+       pushl r1                                # save non-pad addr
+       movl r0,llafx                   # remember width of pad
+       subl2 r0,sp                             # allocate
+       movc5 $0,(r0),r2,llafx,(sp)     # create pad string
+       movl llafx,r0                   # length
+       movl sp,r1                              # addr
+       bsbw strout
+       addl2 llafx,sp                  # deallocate
+       movl (sp)+,r1                   # recover non-pad addr
+       rsb
 
 pone:  .byte   0x1C                    # packed 1
        
 
 pone:  .byte   0x1C                    # packed 1
        
-unsigned:
-lunsigned:
-       extzv $1,$31,(ap),r0            # right shift logical 1 bit
-       cvtlp r0,$10,(sp)               # convert [n/2] to packed
-       movp $10,(sp),8(sp)             # copy packed
-       addp4 $10,8(sp),$10,(sp)        # 2*[n/2] in packed, at (sp)
-       blbc (ap)+,L14                  # n was even
-       addp4 $1,pone,$10,(sp)          # n was odd
-       jbr L14
-
 charac:
 charac:
-       movl $4,r0                      # chars per word
-L18:   movb (ap)+,(r5)+                # transfer char
-       bneq L19
-       decl r5                         # omit null characters
-L19:   sobgtr r0,L18
+       movl (ap)+,r0           # word containing the char
+       movb r0,(r5)+           # one byte, that's all
 
 prbuf:
        movl sp,r1                      # addr first byte
        jbr prstr
 
 
 prbuf:
        movl sp,r1                      # addr first byte
        jbr prstr
 
-plus:  bisl2 $psign,flags              # always print sign for floats
+space: bisl2 $1<blank,flags            # constant width e fmt, no plus sign
+       jbr L4a
+sharp: bisl2 $1<numsgn,flags           # 'self identifying', please
        jbr L4a
        jbr L4a
-minus: bisl2 $ljust,flags              # left justification, please
+plus:  bisl2 $1<plssgn,flags           # always print sign for floats
        jbr L4a
        jbr L4a
-gnum0: jbs $ndfndb,flags,gnum
-       jbs $precb,flags,gnump          # ignore when reading precision
-       bisl2 $zfill,flags              # leading zero fill, please
-gnum:  jbs $precb,flags,gnump
+minus: bisl2 $1<minsgn,flags           # left justification, please
+       jbr L4a
+gnum0: jbs $ndfnd,flags,gnum
+       jbs $prec,flags,gnump           # ignore when reading precision
+       bisl2 $1<zfill,flags            # leading zero fill, please
+gnum:  jbs $prec,flags,gnump
        moval (width)[width],width      # width *= 5;
        movaw -ch.zer(r0)[width],width  # width = 2*witdh + r0 - '0';
        jbr gnumd
 gnump: moval (ndigit)[ndigit],ndigit   # ndigit *= 5;
        movaw -ch.zer(r0)[ndigit],ndigit # ndigit = 2*ndigit + r0 - '0';
        moval (width)[width],width      # width *= 5;
        movaw -ch.zer(r0)[width],width  # width = 2*witdh + r0 - '0';
        jbr gnumd
 gnump: moval (ndigit)[ndigit],ndigit   # ndigit *= 5;
        movaw -ch.zer(r0)[ndigit],ndigit # ndigit = 2*ndigit + r0 - '0';
-gnumd: bisl2 $ndfnd,flags              # digit seen
+gnumd: bisl2 $1<ndfnd,flags            # digit seen
        jbr L4a
 dot:   clrl ndigit                     # start on the precision
        jbr L4a
 dot:   clrl ndigit                     # start on the precision
-       bisl2 $prec,flags
-       bicl2 $ndfnd,flags
+       bisl2 $1<prec,flags
+       bicl2 $1<ndfnd,flags
        jbr L4a
        jbr L4a
-indir: movl (ap)+,ndigit               # width specified by parameter
+indir:
+       jbs $prec,flags,in1
+       movl (ap)+,width                # width specified by parameter
+       jgeq gnumd
+       xorl2 $1<minsgn,flags           # parameterized left adjustment
+       mnegl width,width
+       jbr gnumd
+in1:
+       movl (ap)+,ndigit               # precision specified by paratmeter
+       jgeq gnumd
+       mnegl ndigit,ndigit
        jbr gnumd
        jbr gnumd
-remote:        movl (ap)+,ap
-       movl (ap)+,r11
-       jbr loop
 
 float:
 
 float:
-       bsbw fltcvt
-fltg:  jbs $ndfndb,flags,float1
+       jbs $prec,flags,float1
        movl $6,ndigit                  # default # digits to right of decpt.
        movl $6,ndigit                  # default # digits to right of decpt.
-float1:        addl3 exp,ndigit,r7
+float1:        bsbw fltcvt
+       addl3 exp,ndigit,r7
        movl r7,r6                      # for later "underflow" checking
        bgeq fxplrd
        clrl r7                         # poor programmer planning
        movl r7,r6                      # for later "underflow" checking
        bgeq fxplrd
        clrl r7                         # poor programmer planning
@@ -245,13 +436,13 @@ fxplrd:   cmpl r7,$31                     # expressible in packed decimal?
 fnarro:        subl3 $17,r7,r0                 # where to round
        ashp r0,$17,(sp),$5,r7,16(sp)   # do it
        bvc fnovfl
 fnarro:        subl3 $17,r7,r0                 # where to round
        ashp r0,$17,(sp),$5,r7,16(sp)   # do it
        bvc fnovfl
-       # band-aid for microcode error (spurious overflow)
-       clrl r0                         # assume even length result
-       jlbc r7,fleven                  # right
-       movl $4,r0                      # odd length result
-fleven:        cmpv r0,$4,16(sp),$0            # top digit zero iff true overflow
-       bneq fnovfl
-       # end band-aid
+               # band-aid for microcode error (spurious overflow)
+       #       clrl r0                         # assume even length result
+       #       jlbc r7,fleven                  # right
+       #       movl $4,r0                      # odd length result
+       #fleven:        cmpv r0,$4,16(sp),$0            # top digit zero iff true overflow
+       #       bneq fnovfl
+               # end band-aid
        aobleq $0,r6,fnovfl             # if "underflow" then jump
        movl r7,r0
        incl exp
        aobleq $0,r6,fnovfl             # if "underflow" then jump
        movl r7,r0
        incl exp
@@ -260,28 +451,84 @@ fleven:   cmpv r0,$4,16(sp),$0            # top digit zero iff true overflow
        ashl $-1,r7,r0                  # displ to last byte
        bisb2 sign,16(sp)[r0]           # insert sign
 fnovfl:
        ashl $-1,r7,r0                  # displ to last byte
        bisb2 sign,16(sp)[r0]           # insert sign
 fnovfl:
-       movc3 $4,patsci,(sp)
-       clrl r6                         # # digits moved so far
-       movl exp,r0
-       bleq fexpng
-       bsbb patmov                     # digits to left of decpt.
-fexpng:        tstl ndigit
-       jeql fnodp
-       movc3 $2,fpatdp,(r3)
-       tstl exp
-       bgeq fxppos
-       addl3 exp,ndigit,r6
-       bgeq  flfakl
-       clrl r6                         # it's all fill
-flfakl:        subl3 r6,$31,r6                 # fake length for patmov
-flfill:        movc3 $2,fpatzf,(r3)            # zero fill to right of dec.pt
-fxppos:        movl ndigit,r0
-       bsbb patmov
-fnodp: sobgeq r6,fledit                # must move at least 1 digit
-       movl $31,r6                     # none moved; fake it
-       aobleq $1,ndigit,flfill         # with a one-character zero fill
-fledit:        editpc r7,16(sp),(sp),32(sp)
-       jbr prflt
+       movab 16(sp),r1         # packed source
+       movl r7,r6              # packed length
+       pushab prnum    # goto prnum after fall-through call to fedit
+
+
+       # enter via bsb
+       #       r1=addr of packed source
+       #          16(r1) used to unpack source
+       #          48(r1) used to construct pattern to unpack source
+       #          48(r1) used to hold result
+       #       r6=length of packed source (destroyed)
+       #       exp=# digits to left of decimal point (destroyed)
+       #       ndigit=# digits to right of decimal point (destroyed)
+       #       sign=1 if negative, 0 otherwise
+       # stack will be used for work space for pattern and unpacked source 
+       # exits with
+       #       r1=addr of punctuated result
+       #       r5=addr of last byte +1
+       #       llafx=1 if minus sign inserted, 0 otherwise
+fedit:
+       pushab 48(r1)                   # save result addr
+       movab 48(r1),r3                 # pattern addr
+       movb $0x03,(r3)+                # eo$set_signif
+       movc5 $0,(r1),$0x91,r6,(r3)     # eo$move 1
+       clrb (r3)                               # eo$end
+       editpc r6,(r1),48(r1),16(r1)    # unpack 'em all
+       subl3 r6,r5,r1                  # addr unpacked source
+       movl (sp),r3                    # punctuated output placed here
+       clrl llafx
+       jlbc sign,f1
+       movb $'-,(r3)+          # negative
+       incl llafx
+f1:    movl exp,r0
+       jgtr f2
+       movb $'0,(r3)+          # must have digit before decimal point
+       jbr f3
+f2:    cmpl r0,r6                      # limit on packed length
+       jleq f4
+       movl r6,r0
+f4:    subl2 r0,r6                     # eat some digits
+       subl2 r0,exp            # from the exponent
+       movc3 r0,(r1),(r3)      # (most of the) digits to left of decimal point
+       movl exp,r0                     # need any more?
+       jleq f3
+       movc5 $0,(r1),$'0,r0,(r3)       # '0 fill
+f3:    movl ndigit,r0          # # digits to right of decimal point
+       jgtr f5
+       jbs $numsgn,flags,f5    # no decimal point unless forced
+       jbcs $dpflag,flags,f6   # no decimal point
+f5:    movb $'.,(r3)+          # the decimal point
+f6:    mnegl exp,r0            # "leading" zeroes to right of decimal point
+       jleq f9
+       cmpl r0,ndigit          # cant exceed this many
+       jleq fa
+       movl ndigit,r0
+fa:    subl2 r0,ndigit
+       movc5 $0,(r1),$'0,r0,(r3)
+f9:    movl ndigit,r0
+       cmpl r0,r6                      # limit on packed length
+       jleq f7
+       movl r6,r0
+f7:    subl2 r0,ndigit         # eat some digits from the fraction
+       movc3 r0,(r1),(r3)      # (most of the) digits to right of decimal point
+       movl ndigit,r0                  # need any more?
+       jleq f8
+               # check bounds on users who say %.300f
+       movab 32(r3)[r0],r2
+       subl2 fp,r2
+       jlss fb
+       subl2 r2,r0                     # truncate, willy-nilly
+       movl r0,ndigit          # and no more digits later, either
+fb:
+               #
+       subl2 r0,ndigit         # eat some digits from the fraction
+       movc5 $0,(r1),$'0,r0,(r3)       # '0 fill
+f8:    movl r3,r5                      # addr last byte +1
+       popr $1<1                       # [movl (sp)+,r1] addr first byte
+       rsb
 
 patexp:        .byte   0x03                    # eo$set_signif
        .byte   0x44,'e                 # eo$insert 'e
 
 patexp:        .byte   0x03                    # eo$set_signif
        .byte   0x44,'e                 # eo$insert 'e
@@ -289,118 +536,85 @@ patexp:  .byte   0x03                    # eo$set_signif
        .byte   0x04                    # eo$store_sign
        .byte   0x92                    # eo$move 2
        .byte   0                       # eo$end
        .byte   0x04                    # eo$store_sign
        .byte   0x92                    # eo$move 2
        .byte   0                       # eo$end
-patsci:        .byte   0x42,'+                 # eo$load_plus '+
-       .byte   0x03                    # eo$set_signif
-       .byte   0x04                    # eo$store_sign
-       .byte   0x91                    # eo$move 1
-fpatdp:        .byte   0x44,'.                 # eo$insert '.
-fpatzf:        .byte   0x40,'0                 # eo$load_fill '0
-
-       # construct pattern at (r3) to move  r0  digits in  editpc;
-       #  r6  digits already moved for this number
-patmov:
-       movb $0x90,r2                   # eo$move
-       subl3 r6,$31,r1                 # # digits remaining in packed
-       addl2 r0,r6
-       cmpl r0,r1                      # enough digits remaining?
-       bleq patsml                     # yes
-       tstl exp                        # zero 'fill'; before or after rest?
-       bgeq pataft                     # after
-       pushl r1                        # # digits remaining
-       movb $0x80,r2                   # eo$fill
-       subl3 $31,r6,r0                 # number of fill bytes
-       bsbb patsml                     # recursion!
-       movl (sp)+,r0
-       movb $0x90,r2                   # eo$move
-       jbr patsml
-pataft:        movl r1,r0                      # last of the 31
-       bsbb patsml                     # recursion!
-       subl3 $31,r6,r0                 # number of fill bytes
-       movb $0x80,r2                   # eo$fill
-patsml:        tstl r0
-       bleq patzer                     # DEC doesn't like repetition counts of 0
-       mnegl $15,r1                    # 15 digits at a time
-       subl2 r1,r0                     # counteract acbl
-       jbr pattst
-patmlp:        bisb3 r2,$15,(r3)+              # 15
-pattst:        acbl $16,r1,r0,patmlp           # until <= 15 left
-       bisb3 r2,r0,(r3)+               # rest
-patzer:        clrb (r3)                       # eo$end
-       rsb
 
 scien:
 
 scien:
-       bsbw fltcvt                     # get packed digits
-scig:  incl ndigit
-       jbs $ndfndb,flags,L23
+       incl ndigit
+       jbs $prec,flags,L23
        movl $7,ndigit
        movl $7,ndigit
-L23:   subl3 $17,ndigit,r0             # rounding position
-       ashp r0,$17,(sp),$5,ndigit,16(sp) # shift and round
+L23:   bsbw fltcvt                     # get packed digits
+       movl ndigit,r7
+       cmpl r7,$31                             # expressible in packed decimal?
+       jleq snarro                             # yes
+       movl $31,r7
+snarro:        subl3 $17,r7,r0         # rounding position
+       ashp r0,$17,(sp),$5,r7,16(sp) # shift and round
        bvc snovfl
        bvc snovfl
-       # band-aid for microcode error (spurious overflow)
-       clrl r0                         # assume even length result
-       jlbc ndigit,sceven              # right
-       movl $4,r0                      # odd length result
-sceven:        cmpv r0,$4,16(sp),$0            # top digit zero iff true overflow
-       bneq snovfl
-       # end band-aid
+               # band-aid for microcode error (spurious overflow)
+       #       clrl r0                         # assume even length result
+       #       jlbc ndigit,sceven              # right
+       #       movl $4,r0                      # odd length result
+       #sceven:        cmpv r0,$4,16(sp),$0            # top digit zero iff true overflow
+       #       bneq snovfl
+               # end band-aid
        incl exp                        # rounding overflowed to 100...
        incl exp                        # rounding overflowed to 100...
-       subl3 $1,ndigit,r0
-       ashp r0,$1,pone,$0,ndigit,16(sp)
-       ashl $-1,ndigit,r0              # displ to last byte
+       subl3 $1,r7,r0
+       ashp r0,$1,pone,$0,r7,16(sp)
+       ashl $-1,r7,r0          # displ to last byte
        bisb2 sign,16(sp)[r0]           # insert sign
 snovfl:
        bisb2 sign,16(sp)[r0]           # insert sign
 snovfl:
-       jbc $gflagb,flags,enotg         # not %g format
- # find trailing zeroes in packed number
-       ashl $-1,ndigit,r0
-       addl2 r3,r0                     # addr of l.s.digit and sign
-       movl $4,r1                      # bit position of digit
-       movl ndigit,r7                  # current length of packed
-       jbr gtz
-gtz1:  xorl2 $4,r1                     # position of next digit
-       bneq gtz                        # same byte
-       decl r0                         # different byte
-gtz:   cmpv r1,$4,(r0),$0              # a trailing zero?
-       jneq gntz
-       sobgtr r7,gtz1
-       incl r7
-gntz:                                  # r7: minimum width of fraction
-       cmpl exp,$-4
-       jleq eg                         # small exponents use %e
-       subl3 r7,exp,r0
-       cmpl $5,r0
-       jleq eg                         # so do (w+5) <= exp
-       tstl r0                         # rest use %f
-       jleq fg                         # did we trim too many trailing zeroes?
-       movl exp,r7                     # yes
-fg:    subl3 ndigit,r7,r0
-       ashp r0,ndigit,16(sp),$0,r7,(sp)
-       movp r7,(sp),16(sp)
-       subl3 exp,r7,ndigit             # correct ndigit for %f
-       jbr fnovfl
-eg:    subl3 ndigit,r7,r0
-       ashp r0,ndigit,16(sp),$0,r7,(sp)
-       movp r7,(sp),16(sp)
-       movl r7,ndigit                  # packed number has been trimmed
-enotg:
-       movc3 $7,patsci,(sp)
-       movl $1,r6                      # 1P
-       subl3 $1,ndigit,r0              # digits after dec.pt
-       bsbw patmov
-       editpc ndigit,16(sp),(sp),32(sp)        # 32(sp)->result, r5->(end+1)
-       decl exp                        # compensate: 1 digit left of dec.pt
-       cvtlp exp,$2,(sp)               # exponent
+       jbs $gflag,flags,gfmt           # %g format
+       movab 16(sp),r1
+       bsbb eedit
+eexp:
+       movl r1,r6              # save fwa from destruction by cvtlp
+       subl3 $1,sexp,r0        # 1P exponent
+       cvtlp r0,$2,(sp)        # packed
        editpc $2,(sp),patexp,(r5)
        editpc $2,(sp),patexp,(r5)
-prflt: movab 32(sp),r1
-       jbs $psignb,flags,prflt1
-       cmpb (r1)+,$'+
-       beql prflt1
-       decl r1
-prflt1:        skpc $' ,$63,(r1)
-       jbr prstr
+       movl r6,r1              # fwa
+       jbc $caps,flags,prnum
+       xorb2 $'e^'E,-4(r5)
+       jbr prnum
+
+eedit:
+       movl r7,r6              # packed length
+       decl ndigit             # 1 digit before decimal point
+       movl exp,sexp   # save from destruction
+       movl $1,exp             # and pretend
+       jbr fedit
+
+gfmt:
+       addl3 $3,exp,r0         # exp is 1 more than e
+       jlss gfmte              # (e+1)+3<0, e+4<=-1, e<=-5
+       subl2 $3,r0             # exp [==(e+1)]
+       cmpl r0,ndigit
+       jgtr gfmte              # e+1>n, e>=n
+gfmtf:
+       movl r7,r6
+       subl2 r0,ndigit         # n-e-1
+       movab 16(sp),r1
+       bsbw fedit
+g1:    jbs $numsgn,flags,g2
+       jbs $dpflag,flags,g2    # dont strip if no decimal point
+g3:    cmpb -(r5),$'0          # strip trailing zeroes
+       jeql g3
+       cmpb (r5),$'.           # and trailing decimal point
+       jeql g2
+       incl r5
+g2:    jbc $gflag,flags,eexp
+       jbr prnum
+gfmte:
+       movab 16(sp),r1         # packed source
+       bsbw eedit
+       jbsc $gflag,flags,g1    # gflag now means "use %f" [hence no exponent]
 
 general:
 
 general:
-       jbcs $gflagb,flags,scien
-       jbr scien                       # safety net
+       jbs $prec,flags,gn1
+       movl $6,ndigit          # default precision is 6 significant digits
+gn1:   tstl ndigit             # cannot allow precision of 0
+       jgtr gn2
+       movl $1,ndigit          # change 0 to 1, willy-nilly
+gn2:   jbcs $gflag,flags,L23
+       jbr L23                 # safety net
 
        # convert double-floating at (ap) to 17-digit packed at (sp),
        # set 'sign' and 'exp', advance ap.
 
        # convert double-floating at (ap) to 17-digit packed at (sp),
        # set 'sign' and 'exp', advance ap.
@@ -413,11 +627,14 @@ fltcvt:
        incb sign
 fpos:
        extzv $7,$8,r5,r2               # exponent of 2
        incb sign
 fpos:
        extzv $7,$8,r5,r2               # exponent of 2
-       movaw -0600(r2)[r2],r2          # unbias and mult by 3
-       bgeq epos
-       subl2 $9,r2
-epos:  divl2 $10,r2
-       bsbb expten
+       movab -0200(r2),r2              # unbias
+       mull2 $59,r2                    # 59/196: 3rd convergent continued frac of log10(2)
+       jlss eneg
+       movab 196(r2),r2
+eneg:
+       movab -98(r2),r2
+       divl2 $196,r2
+       bsbw expten
        cmpd r0,r5
        bgtr ceil
        incl r2
        cmpd r0,r5
        bgtr ceil
        incl r2
@@ -434,6 +651,18 @@ fz1:       cvtlp r0,$9,16(sp)              # leading 9 digits
        ashp $8,$9,16(sp),$0,$17,4(sp)  # as top 9 of 17
        emodd ten8,$0,r5,r0,r5
        cvtlp r0,$8,16(sp)              # trailing 8 digits
        ashp $8,$9,16(sp),$0,$17,4(sp)  # as top 9 of 17
        emodd ten8,$0,r5,r0,r5
        cvtlp r0,$8,16(sp)              # trailing 8 digits
+               # if precision >= 17, must round here
+       movl ndigit,r7                  # so figure out what precision is
+       pushab scien
+       cmpl (sp)+,(sp)
+       jleq gm1                        # who called us?
+       addl2 exp,r7                    # float; adjust for exponent
+gm1:   cmpl r7,$17
+       jlss gm2
+       cmpd r5,$0d0.5                  # must round here; check fraction
+       jlss gm2
+       bisb2 $0x10,8+4(sp)             # increment l.s. digit
+gm2:           # end of "round here" code
        addp4 $8,16(sp),$17,4(sp)       # combine leading and trailing
        bisb2 sign,12(sp)               # and insert sign
        rsb
        addp4 $8,16(sp),$17,4(sp)       # combine leading and trailing
        bisb2 sign,12(sp)               # and insert sign
        rsb
@@ -441,10 +670,13 @@ fzero:    clrl r0
        movl $1,exp             # 0.000e+00 and 0.000 rather than 0.000e-01 and .000
        jbr fz1
 
        movl $1,exp             # 0.000e+00 and 0.000 rather than 0.000e-01 and .000
        jbr fz1
 
+       .align 2
+lsb: .long 0x00010000          # lsb in the crazy floating-point format
+
        # return 10^r2 as a double float in r0||r1 and 8 extra bits of precision in r4
        # preserve r2, r5||r6
 expten:
        # return 10^r2 as a double float in r0||r1 and 8 extra bits of precision in r4
        # preserve r2, r5||r6
 expten:
-       movd $one,r0                    # begin computing 10^exp10
+       movd $0d1.0,r0                  # begin computing 10^exp10
        clrl r4                         # bit counter
        movad ten1,r3                   # table address
        tstl r2
        clrl r4                         # bit counter
        movad ten1,r3                   # table address
        tstl r2
@@ -456,16 +688,49 @@ e10lp:    jbc r4,r2,el1                   # want this power?
 el1:   addl2 $8,r3                     # advance to next power
        aobleq $5,r4,e10lp              # through 10^32
        jbcc $6,r2,el2                  # correct for negative exponent
 el1:   addl2 $8,r3                     # advance to next power
        aobleq $5,r4,e10lp              # through 10^32
        jbcc $6,r2,el2                  # correct for negative exponent
-       divd3 r0,$one,r0                # by taking reciprocal
-       mnegl r2,r2
-el2:   clrl r4                         # 8 extra bits of precision
+       divd3 r0,$0d1.0,r0              # by taking reciprocal
+       cmpl $28,r2
+       jneq enm28
+       addl2 lsb,r1                    # 10**-28 needs lsb incremented
+enm28: mnegl r2,r2                     # original exponent of 10
+el2:   addl3 $5*8,r2,r3                # negative bit positions are illegal?
+       jbc r3,xlsbh-5,eoklsb
+       subl2 lsb,r1                    # lsb was too high
+eoklsb:
+       movzbl xprec[r2],r4             # 8 extra bits
        rsb
 
        # powers of ten
        rsb
 
        # powers of ten
-       .align  3
+       .align  2
 ten1:  .word   0x4220,0,0,0
 ten2:  .word   0x43c8,0,0,0
 ten4:  .word   0x471c,0x4000,0,0
 ten8:  .word   0x4dbe,0xbc20,0,0
 ten16: .word   0x5b0e,0x1bc9,0xbf04,0
 ten32: .word   0x759d,0xc5ad,0xa82b,0x70b6
 ten1:  .word   0x4220,0,0,0
 ten2:  .word   0x43c8,0,0,0
 ten4:  .word   0x471c,0x4000,0,0
 ten8:  .word   0x4dbe,0xbc20,0,0
 ten16: .word   0x5b0e,0x1bc9,0xbf04,0
 ten32: .word   0x759d,0xc5ad,0xa82b,0x70b6
+
+       # whether lsb is too high or not
+       .byte 1:0,1:0,1:0,1:0,1:1,1:0,1:1,1:0   # -40 thru -33
+       .byte 1:0,1:1,1:0,1:0,1:0,1:0,1:1,1:0   # -32 thru -25
+       .byte 1:0,1:0,1:1,1:1,1:1,1:1,1:0,1:0   # -24 thru -17
+       .byte 1:0,1:1,1:0,1:0,1:1,1:1,1:1,1:1   # -16 thru -9
+       .byte 1:1,1:1,1:1,1:0,1:0,1:0,1:0,1:1   # -8  thru -1
+xlsbh:
+       .byte 1:0,1:0,1:0,1:0,1:0,1:0,1:0,1:0   # 0 thru 7
+       .byte 1:0,1:0,1:0,1:0,1:0,1:0,1:0,1:0   # 8 thru 15
+       .byte 1:0,1:0,1:0,1:0,1:0,1:0,1:0,1:0   # 16 thru 23
+       .byte 1:0,1:1,1:1,1:0,1:1,1:1,1:1,1:1   # 24 thru 31
+       .byte 1:1,1:1,1:1,1:1,1:1,1:1,1:1       # 32 thru 38
+
+       # bytes of extra precision
+       .byte           0x56,0x76,0xd3,0x88,0xb5,0x62   # -38 thru -33
+       .byte 0xba,0xf5,0x32,0x3e,0x0e,0x48,0xdb,0x51   # -32 thru -25
+       .byte 0x53,0x27,0xb1,0xef,0xeb,0xa5,0x07,0x49   # -24 thru -17
+       .byte 0x5b,0xd9,0x0f,0x13,0xcd,0xff,0xbf,0x97   # -16 thru -9
+       .byte 0xfd,0xbc,0xb6,0x23,0x2c,0x3b,0x0a,0xcd   # -8  thru -1
+xprec:
+       .byte 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00   # 0  thru 7
+       .byte 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00   # 8  thru 15
+       .byte 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00   # 16 thru 23
+       .byte 0x00,0xa0,0xc8,0x3a,0x84,0xe4,0xdc,0x92   # 24 thru 31
+       .byte 0x9b,0x00,0xc0,0x58,0xae,0x18,0xef        # 32 thru 38