'{$STAMP BS2pe}
'{$PBASIC 2.5}
' divide32x32.bse  (c) 2003 Tracy Allen http://www.owlogic.com
' computes long division, 32 bit numerator by 32 bit denominator
' unsigned
' N = D * Q + R, find Q and R given N and D
' for BASIC Stamp using 2-word double precision algorithm
' debug code commented back in will show intermediate results

n0       VAR  Word           ' numerator entered by user
n1       VAR  Word

d0       VAR  Word           ' denominator entered by user
d1       VAR  Word

q0       VAR  Word           ' quotient to be computed
q1       VAR  Word

r0       VAR  Word           ' remainder to be computed
r1       VAR  Word
r2       VAR  Bit

x0       VAR  Word           ' working variable
x1       VAR  Word
x2       VAR  Bit

cb       VAR  Bit		' carry/borrow

kn       VAR  Byte		' number of significant bits
kw       CON	32		' word size of numerator
idx      VAR  Byte		' index

top:
' demo asks user to input two numbers to test
SEROUT 16,$54,[CR,"enter 8 hex digits each for numerator and denominator (0..9 a..f)"]

SEROUT 16,$54,[CR,"numerator 00000000: "]
SERIN 16,$54,[HEX4 n1,HEX4 n0]

SEROUT 16,$54,[CR,"denominator 00000000: "]
SERIN 16,$54,[HEX4 d1,HEX4 d0]

SEROUT 16,$54,[CR,"thank you..."]

test_divide_by_zero:
IF d0|d1=0 THEN
  SEROUT 16,$54,[CR,"divide by zero" ,CR]
  GOTO top
  ENDIF

find_N_bits:
GOSUB find_nbits	' find number of significant bits in N
' DEBUG 32,DEC kn ,32                             		' show number

GOSUB zero_accumulators

show_N_is_zero:
IF kn=0 THEN
  SEROUT 16,$54,[CR,"numerator is zero"]
  GOTO display
  ENDIF

test_N_less_than_D:
' pretest n<d
' not necessary to do this
' because the main algorithm will resolve the quotient and remainder correctly
' but this can save time
  r0=n0
  r1=n1
  r2=0
  GOSUB R_minus_D
  IF cb=1 THEN
    SEROUT 16,$54,[CR,"numerator<denominator"]
    r0=n0
    r1=n1
    GOTO display
  ENDIF

main_initialize:
GOSUB zero_accumulators
IF kn<kw THEN
  FOR idx=1 TO kw-kn		' left justify N
    GOSUB Nshift
  NEXT
ENDIF
' DEBUG HEX4 n1,HEX4 n0				' show left justify

main_calculation:
  FOR idx=kn TO 1
    GOSUB Nshift
    GOSUB Rshift
    GOSUB R_minus_D
    cb=~cb         	' complement carry.  cb=1 iff R>=D
    GOSUB Qshift
    IF cb=1 THEN	' R>=D --> relace R with R-D
      r0=x0
      r1=x1
      r2=x2
    ENDIF
'   DEBUG CR,TAB, BIN1 r2,HEX4 r1,HEX4 r0	' show remainder
'   DEBUG TAB, BIN1 x2,HEX4 x1,HEX4 x0         ' show workspace
'   DEBUG TAB,BIN1 cb,TAB				' show carry
'   DEBUG TAB, HEX4 q1,HEX4 q0            	' show quotient
  NEXT

display:
  SEROUT 16,$54,[CR,"  quotient: ",HEX4 q1,HEX4 q0]
  SEROUT 16,$54,[CR,"  remainder: ",HEX4 r1, HEX4 r0,CR,CR]

GOTO top


' -subroutines-------------------------------------------

zero_accumulators:
  q0=0
  q1=0
  r0=0
  r1=0
  r2=0
RETURN

' find number of significant bits in numerator n1:n0 up to 32 bits
' a result kn=0 means numerator is zero
find_nbits:
  kn=0
  idx=1
find_nbits1:
  kn=NCD n1
  IF kn=0 THEN
    kn=NCD n0
  ELSE
    kn=kn+16
  ENDIF
RETURN

' shift numerator n1:n0 one bit left into cb, zero into lsbit
Nshift:
  cb=n1.BIT15
  n1=n1<<1|n0.BIT15
  n0=n0<<1
RETURN

' shift quotient q1:q0 one bit left, and cb into lsbit
Qshift:
  q1=q1<<1|q0.BIT15
  q0=q0<<1|cb
RETURN

' shift remainder r2:r1:r0 left, and cb into lsbit
' shift can move one more bit into r3
' but subtraction of d2:d1:d0 will always keep result to two bytes
' workspace is at least one bit larger than D
Rshift:
  r2=r1.BIT15
  r1=r1<<1|r0.BIT15
  r0=r0<<1|cb
RETURN

' compute R-D and set cb=1 if a borrow occurs (D>R)
' x2:x1:x0 is a workspace variable, as with R, at least one bit larger than D.
R_minus_D:
  x0=r0-d0
  IF d0>r0 THEN cb=1 ELSE cb=0   ' borrow- (x0 min r0 - r0 max 1)

  x1=d1+cb
  IF x1<d1 THEN cb=1 ELSE cb=0
  x1=r1-x1
  IF x1>r1 THEN cb=1

  x2=r2-cb
  IF x2>r2 THEN cb=1 ELSE cb=0 	' x3 and r3 are bit variables, final carry
RETURN

' alternative form R-D using computed carry instead of IF-THEN-ELSE
' note Stamp does not have a carry/borrow bit
' remember when three terms are in a sum, either operation can generate a carry
' if one of the terms is 1, then there can only be one carry
R_minus_D_alternate:
  x0=r0-d0
  cb=d0 MIN r0 - r0 MAX 1

  x1=d1+cb
  cb=x1 MAX d1 - d1 MAX 1
  x1=r1-x1
  cb=x1 MIN r1 - r1 MAX 1 | cb

  x2=r2-cb
  cb=cb MIN r2 -r2 MAX 1
RETURN

DEBUG HOME