.title   trn$int_x -- translate a string to integer
      .library 'god$lib:'
 
;
; some useful constants
;
c_blank   = ^a/ /
c_plus    = ^a/+/
c_comma   = ^a/,/
c_minus   = ^a/-/
c_zero    = ^a/0/
c_nine    = ^a/9/
c_biga    = ^a/A/
c_bigz    = ^a/Z/
c_lbrack  = ^a/[/
c_rbrack  = ^a/]/
c_lita    = ^a/a/
c_litz    = ^a/z/
n_digits  = c_nine - c_zero + 1
 
      $esect   _trn$code
 
;
; convert string to integer, using variable base
;
;  Format:
;    length = trn$int_<x>( str, int, [base] )
;      where length is a longword, str is a string (by descriptor), int is
;      an <x> (by reference), and base is a byte (by reference or value)
;
;  Entry points:
;    trn$int_b(...)    - to byte integer
;    trn$int_w(...)    - to word integer
;    trn$int_l(...)    - to longword integer
;    trn$int_ub(...)   - to (unsigned) byte integer
;    trn$int_uw(...)   - to (unsigned) word integer
;    trn$int_ul(...)   - to (unsigned) longword integer
;
; register usage:
;  r0  -- temporary
;  r1  -- base
;  r2  -- accumulator
;  r3  -- second half of r2
;  r4  -- number of characters left in string
;  r5  -- addr of next character in string
;  r6  -- flags
;
 
mask  = ^m<r2,r3,r4,r5,r6>
f_typ = 0
f_uns = 2
f_neg = 8
f_err = 9
 
      .entry   trn$int_b, mask
      movl     #0, r6
      brb      int_x
 
      .entry   trn$int_w, mask
      movl     #1, r6
      brb      int_x
 
      .entry   trn$int_l, mask
      movl     #2, r6
      brb      int_x
 
      .entry   trn$int_ub, mask
      movl     #4, r6
      brb      int_x
 
      .entry   trn$int_uw, mask
      movl     #5, r6
      brb      int_x
 
      .entry   trn$int_ul, mask
      movl     #6, r6
 
int_x:
      movq     @4(ap), r4               ; load string descr
      movzwl   r4, r4
      callg    (ap), l_blank            ; count preceeding blanks
      addl2    r0, r5                   ; and ignore them
      subl2    r0, r4
 
      clrl     r2                       ; clear accumulator
      cmpl     (ap), #3                 ; look for third parameter
      blssu    10$
      movab    @12(ap), r1              ; get third param (base)
      beql     10$                      ; if 0, use base 10
      cmpl     r1, #^x200               ; if < 200 (hex),
      blssu    20$                      ; use it directly
      movzbl   (r1), r1                 ; else dereference it first
      brb      20$
10$:
      movl     #10, r1                  ; if no third parameter, use base 10
 
20$:
      cmpb     (r5), #c_plus            ; test for sign
      beql     30$
      cmpb     (r5), #c_minus           ; if leading -...
      bneq     loop
      bbss     #f_neg, r6, 30$          ; set negative flag
30$:
      incl     r5                       ; if a sign char,
      decl     r4                       ; skip over it
 
; loop for going through the string
loop:
      sobgeq   r4, 10$                  ; test for end of string
      movl     #-1, r4
      brb      end
10$:
      movzbl   (r5)+, r0                ; get next char in string
 
      cmpl     r0, #c_nine              ; off top end of digits?
      bgtr     20$
      subl2    #c_zero, r0              ; off bottom end?
      blss     end
      brb      add                      ; go add it to number
20$:
      cmpl     r0, #c_bigz              ; off top end of uppercase letters?
      bgtr     30$
      cmpl     r0, #c_biga              ; off bottom end?
      blss     end
      subl2    #<c_biga-n_digits>, r0
      brb      add                      ; go add it to number
30$:
      cmpl     r0, #c_litz              ; off top end of lowercase letters?
      bgtr     end
      cmpl     r0, #c_lita              ; off bottom end?
      blss     end
      subl2    #<c_lita-n_digits>, r0
 
add:
      cmpl     r0, r1                   ; is digit bigger than base?
      bgeq     end
      emul     r1, r2, r0, r2           ; mult. accum. by base and add digit
      tstl     r3                       ; check for overflow
      beql     loop
      bbss     #f_err, r6, loop         ; set error flag
      brb      loop
 
; we got to the end of the number
end:
      bbc      #f_neg, r6, 20$; if the number was negative...
      mnegl    r2, r2                   ; negate it
      beql     case                     ; if -0, everything's ok
      bgtr     10$                      ; if it wrapped, error
      bbc      #f_uns, r6, case         ; if supposed to be unsigned...
10$:
      bbss     #f_err, r6, case         ; set error bit
      brb      case
 
20$:                          ; if the number was positive...
      bbs      #f_uns, r6, case         ; if unsigned, all's well
      tstl     r2                       ; else, make sure it's not too big
      bgeq     case                     ; if overflow...
      bbss     #f_err, r6, case         ; set error flag
 
case:
      caseb    r6, #0, #7
1$:     .word    sb - 1$                ; signed byte
        .word    sw - 1$                ; signed word
        .word    sl - 1$                ; signed longword
        .word    10$ - 1$               ; error
        .word    ub - 1$                ; unsigned byte
        .word    uw - 1$                ; unsigned word
        .word    ul - 1$                ; unsigned longword
10$:
      movl     #1000, r0      ; internal error.
      ret                     ; this should never happen
 
sb:            ; signed byte
      movb     r2, @8(ap)
      cvtbl    r2, r0
      brb      check
 
sw:            ; signed word
      movw     r2, @8(ap)
      cvtwl    r2, r0
      brb      check
 
sl:            ; signed longword
      movl     r2, @8(ap)
      movl     r2, r0
      brb      check
 
ub:            ; unsigned byte
      movb     r2, @8(ap)
      movzbl   r2, r0
      brb      check
 
uw:            ; unsigned word
      movw     r2, @8(ap)
      movzwl   r2, r0
      brb      check
 
ul:            ; unsigned longword
      movl     r2, @8(ap)
      movl     r2, r0
 
check:              ; check for high bits that got truncated on output
      cmpl     r0, r2
      beql     10$            ; if input and output don't match
      bbss     #f_err, r6, 10$; set error flag
10$:
      movzwl   @4(ap), r0     ; figure out length of number
      subl2    r4, r0
      decl     r0
 
      bbc      #f_err, r6, 20$; if overflow error...
      mnegl    r0, r0         ; return negative length
20$:
      ret
 
      .end