# 2.11BSD#431 - /usr/src/new/m11/fltg.m11

       1:         .title  fltg
       2:
       3:         .ident  /27dec3/
       4:
       5:         .mcall  (at)always,xmit,genedt,error
       6:         .mcall  (at)sdebug,ndebug
       7:         always
       8:
       9:         .globl  savreg, abstrm, chrpnt, cpopj,  cradix
      10:         .globl  getchr, getnb,  mode
      11:         .globl  setnb,  stcode, tstarg, value
      12:         .globl  edmask, ed.fpt
      13:
      14:
      15:         .if ndf xfltg
      16:
      17:         .globl  flt2,   flt4,   fltg1w
      18:
      19:         xitsec                  ;start in default sector
      20:
      21:
      22: flt4:   inc     r3
      23: flt2:
      24:         inc     r3              ;make it 1 or 2
      25:         asl     r3              ;now 2 or 4
      26: fp.1:   call    tstarg
      27:         beq     fp.9
      28:         mov     fltpnt-2(r3),-(sp)      ;evaluate number
      29:         call    @(sp)+
      30:         bne     fp.2            ;branch if non-null
      31:         error   9,a,<empty floating point number>               ;  null, flag error
      32: fp.2:   mov     r3,r2           ;get a working count
      33:         mov     #fltbuf,r1      ;point to floating point buffer
      34: 3$:     mov     (r1)+,(r4)      ;move in next number
      35:         call    stcode          ;place on code roll
      36:         sob     r2,3$           ;loop on word count
      37:         br      fp.1            ;continue
      38:
      39: fp.9:   return
      40:
      41:         entsec  dpure
      42: fltpnt: .word   fltg2w, fltg4w
      43:         xitsec
      44:
      45:         .if ndf xedfpt
      46:         genedt  fpt             ;floating point truncation
      47:         .endc
      48:
      49: fltg4w: inc     fltwdc          ;floating point number evaluator
      50: fltg2w: inc     fltwdc
      51: fltg1w:
      52:         call    savreg          ;save registers
      53:         mov     chrpnt,-(sp)    ;stack current character pointer
      54:         mov     #fltbuf,r3      ;convenient copy of pointers
      55:         mov     #fltsav,r4      ;  to buffer and save area
      56:         mov     r4,r1
      57: 1$:     clr     -(r1)           ;init variables
      58:         cmp     r1,#fltbeg
      59:         bhi     1$              ;loop until done
      60:         mov     #65.,fltbex     ;init binary exponent
      61:         cmp     #'+,r5          ;  "+"?
      62:         beq     10$             ;  yes, bypass and ignore
      63:         cmp     #'-,r5          ; "-"?
      64:         bne     11$             ;  no
      65:         mov     #100000,fltsgn  ;yes, set sign and bypass char
      66: 10$:    call    getchr          ;get the next character
      67: 11$:    cmp     r5,#'0          ;numeric?
      68:         blo     20$
      69:         cmp     r5,#'9
      70:         bhi     20$             ;  no
      71:         bit     #174000,(r3)    ;numeric, room for multiplication?
      72:         beq     12$             ;  yes
      73:         inc     fltexp          ;no, compensate for the snub
      74:         br      13$
      75:
      76: 12$:    call    fltm50          ;multiply by 5
      77:         call    fltgls          ;correction, make that *10
      78:         sub     #'0,r5          ;make absolute
      79:         mov     r4,r2           ;point to end of buffer
      80:         add     r5,-(r2)        ;add in
      81:         adc     -(r2)           ;ripple carry
      82:         adc     -(r2)
      83:         adc     -(r2)
      84: 13$:    add     fltdot,fltexp   ;decrement if processing fraction
      85:         clr     (sp)            ;clear initial char pointer (we're good)
      86:         br      10$             ;try for more
      87:
      88: 20$:    cmp     #'.,r5          ;decimal point?
      89:         bne     21$             ;  no
      90:         com     fltdot          ;yes, mark it
      91:         bmi     10$             ;loop if first time around
      92: 21$:    cmp     #105,r5         ;exponent?(routine  is passed upper case)
      93:         bne     fltg3           ;  no
      94:         call    getnb           ;yes, bypass "e" and blanks
      95:         mov     cradix,-(sp)    ;stack current radix
      96:         mov     #10.,cradix     ;set to decimal
      97:         call    abstrm          ;absolute term
      98:         mov     (sp)+,cradix    ;restore radix
      99:         add     r0,fltexp       ;update exponent
     100: ;	br	fltg3		;fall through
     101: fltg3:  mov     r3,r1
     102:         mov     (r1)+,r0        ;test for zero
     103:         bis     (r1)+,r0
     104:         bis     (r1)+,r0
     105:         bis     (r1)+,r0
     106:         jeq     fltgex          ;exit if so
     107: 31$:    tst     fltexp          ;time to scale
     108:         beq     fltg5           ;fini if zero
     109:         blt     41$             ;divide if .lt. zero
     110:         cmp     (r3),#031426    ;multiply, can we *5?
     111:         bhi     32$             ;  no
     112:         call    fltm50          ;yes, multiply by 5
     113:         inc     fltbex          ;  and by two
     114:         br      33$
     115:
     116: 32$:    call    fltm54          ;multiply by 5/4
     117:         add     #3.,fltbex      ;  and by 8
     118: 33$:    dec     fltexp          ;  over 10
     119:         br      31$
     120:
     121: 40$:    dec     fltbex          ;division, left justify bits
     122:         call    fltgls
     123: 41$:    tst     (r3)            ;sign bit set?
     124:         bpl     40$             ;  no, loop
     125:         mov     #16.*2,-(sp)    ;16 outer, 2 inner
     126:         call    fltgrs          ;shift right
     127:         call    fltgsv          ;place in save buffer
     128: 42$:    bit     #1,(sp)         ;odd lap?
     129:         bne     43$             ;  yes
     130:         call    fltgrs          ;move a couple of bits right
     131:         call    fltgrs
     132: 43$:    call    fltgrs          ;once more to the right
     133:         call    fltgad          ;add in save buffer
     134:         dec     (sp)            ;end of loop?
     135:         bgt     42$             ;  no
     136:         tst     (sp)+           ;yes, prune stack
     137:         sub     #3.,fltbex
     138:         inc     fltexp
     139:         br      31$
     140: fltg5:  dec     fltbex          ;left justift
     141:         call    fltgls
     142:         bcc     fltg5           ;lose one bit
     143:         add     #200,fltbex     ;set excess 128.
     144:         ble     2$              ;branch if under-flow
     145:         tstb    fltbex+1        ;high order zero?
     146:         beq     fg53$           ;  yes
     147: 2$:     error   10,n,<floating point overflow>          ;no, error
     148: fg53$:  mov     r4,r2           ;set to shift eight bits
     149:         mov     r2,r1
     150:         tst     -(r1)           ;r1 is one lower than r2
     151: 4$:     cmp     -(r1),-(r2)     ;down one word
     152:         movb    (r1),(r2)       ;move up a byte
     153:         swab    (r2)            ;beware of the inside-out pc!!
     154:         cmp     r2,r3           ;end?
     155:         bne     4$
     156:         call    fltgrs          ;shift one place right
     157:         ror     (r4)            ;set high carry
     158:         .if ndf xedfpt
     159:         bit     #ed.fpt,edmask  ;truncation?
     160:         beq     fp57$           ;  yes
     161:         .endc
     162:         mov     fltwdc,r2       ;get size count
     163:         asl     r2              ;double
     164:         bne     8$              ;preset type
     165:         inc     r2              ;single word
     166: 8$:     asl     r2              ;convert to bytes
     167:         bis     #077777,fltbuf(r2)
     168:         sec
     169: 5$:     adc     fltbuf(r2)
     170:         dec     r2
     171:         dec     r2
     172:         bge     5$
     173:         tst     (r3)            ;test sign position
     174:         bpl     fp57$           ;ok if positive
     175: 6$:     error   11,t,<trunctation error>
     176: fp57$:  add     fltsgn,(r3)     ;set sign, if any
     177: fltgex: clr     mode            ;make absolute
     178:         clr     fltwdc          ;clear count
     179:         mov     (r3),value      ;place first guy in value
     180:         mov     (sp)+,r0        ;origional char pointer
     181:         beq     1$              ;zero (good) if any digits processed
     182:         mov     r0,chrpnt       ;none, reset to where we came in
     183:         clr     r3              ;flag as false
     184: 1$:     mov     r3,r0           ;set flag in r0
     185:         jmp     setnb           ;return with non-blank
     186: fltm54:                         ;*5/4
     187:         cmp     (r3),#146314    ;room?
     188:         blo     1$
     189:         call    fltgrs
     190:         inc     fltbex
     191: 1$:     call    fltgsv          ;save in backup
     192:         call    fltgrs          ;scale right
     193:         call    fltgrs
     194:         br      fltgad
     195:
     196: fltm50:                         ;*5
     197:         call    fltgsv
     198:         call    fltgls
     199:         call    fltgls
     200:
     201: fltgad:                         ;add save buffer to fltbuf
     202:         mov     r4,r2           ;point to save area
     203: 1$:     add     6(r2),-(r2)     ;add in word
     204:         mov     r2,r1           ;set for carries
     205: 2$:     adc     -(r1)           ;add in
     206:         bcs     2$              ;continue ripple, if necessary
     207:         cmp     r2,r3           ;through?
     208:         bne     1$              ;  no
     209:         return
     210: fltgrs: clc                     ;right shift
     211:         mov     r3,r1           ;right rotate
     212:         ror     (r1)+
     213:         ror     (r1)+
     214:         ror     (r1)+
     215:         ror     (r1)+
     216:         return
     217:
     218: fltgls:                         ;left shift
     219:         mov     r4,r2
     220:         asl     -(r2)
     221:         rol     -(r2)
     222:         rol     -(r2)
     223:         rol     -(r2)
     224:         return
     225:
     226: fltgsv: mov     r3,r1           ;move fltbuf to fltsav
     227:         mov     r4,r2
     228:         xmit    4
     229:         return
     230:
     231:
     232:         entsec  impure
     233: fltbeg:                         ;start of floating point impure
     234: fltsgn: .blkw                   ;sign bit
     235: fltdot: .blkw                   ;decimal point flag
     236: fltexp: .blkw                   ;decimal exponent
     237: fltbex: .blkw   1               ;binary exponent (must preceed fltbuf)
     238: fltbuf: .blkw   4               ;main ac
     239: fltsav: .blkw   4
     240:
     241:         entsec  implin
     242: fltwdc: .blkw                   ;word count
     243:
     244:         xitsec
     245:
     246:
     247:         .endc
     248:
     249:         .end

Last modified: 1982-12-11 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 619 |