home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / BDSC / BDSC-3 / LONG1.CQM / LONG1.CSM
Text File  |  2000-06-30  |  8KB  |  478 lines
  1. ;  Long Integer Package  -   Assembly Code Portion
  2. ;
  3. ;  Rob Shostak        7/82
  4. ;
  5. ;  This is the assembly language portion of a BDS-C library package
  6. ;  to enable the manipulation of long integers (which we also call
  7. ;  "quads", since they occupy 4 bytes) in the same spirit as Bob
  8. ;  Mathias' floating point package.  See long.c  and long.doc
  9. ;
  10.  
  11.  INCLUDE "bds.lib"
  12.  
  13.  FUNCTION long
  14.  
  15. ; temporary storage is allocated in the
  16. ; "args" area of the run-time environment
  17.  
  18. u    equ  args    ;temporary quad storage (4 bytes)
  19. uh    equ  u        ;high word of u
  20. ul    equ  u+2    ;low word of u
  21. mq    equ  u+4    ;temporary quad storage used by
  22.             ;multiplication and division routines
  23. temp    equ  mq+4    ;temporary storage byte used by div'n routine
  24.  
  25.  
  26. ; long is main routine which dispatches to the various functions
  27. ; of the package according to the value of its first argument
  28.  
  29. long:    push b        ;save for benefit of caller
  30.     call ma2toh    ;get 1st arg (function code) into HL and A
  31.     mov  d,h
  32.     mov  e,l
  33.     dad  h
  34.     dad  d        ;HL now has triple the function code
  35.     lxi  d,jtab    ;base of jump table
  36.     dad  d
  37.     pchl        ;dispatch to appropriate function
  38.  
  39. jtab:    jmp  lmake    ;jump table for quad functions
  40.     jmp  lcomp
  41.     jmp  ladd
  42.     jmp  lsub
  43.     jmp  lmul
  44.     jmp  ldiv
  45.     jmp  lmod
  46.  
  47.  
  48. ; lmake converts integer (arg3) to a long (arg2)
  49.  
  50. lmake:    call ma4toh    ;get arg3 into HL
  51.     mov  a,h    ;look at sign first
  52.     ora  a
  53.     push psw    ;save it
  54.     cm   cmh    ;take abs value
  55.     xchg        ;into (DE)
  56.     lxi  b,0    ;zero out high word
  57.     pop  psw
  58.     cm   qneg    ;complement if necessary
  59.     jmp  putarg    ;copy result into arg2 and return
  60.  
  61. ;all other routines copy their arguments into the quad register (BCDE)
  62. ;and the temporary quad storage location u  (note that temporary storage
  63. ;must be used to keep the routines from clobbering the user's arguments)
  64.  
  65.  
  66. ;lcomp compares arg2 with arg3, returns -1, 0, 1 for <, =, >, resp
  67.  
  68. lcomp:  call ma3toh    ;get pointer to arg2
  69.     call qld    
  70.     lxi  h,u
  71.     call qst    ;arg2 now in u
  72.     call ma4toh    ;get pointer to arg3
  73.     call qld    ;arg3 now in (BCDE)
  74.     lxi  h,-1    ;presume <
  75.     call qsub
  76.     call qtst
  77.     pop  b        ;restore bc for caller
  78.     rm
  79.     inx  h
  80.     rz
  81.     inx  h
  82.     ret
  83.  
  84. ; long addition
  85.  
  86. ladd:    call getargs    ;get args into (BCDE) and u
  87.     call qadd    ;do the addition
  88.     jmp  putarg    ;copy result into arg2 and return
  89.  
  90. lsub:    call getargs
  91.     call qsub
  92.     jmp  putarg
  93.  
  94. lmul:    call getargs
  95.     call qmul
  96.     jmp  putarg
  97.  
  98. ldiv:    call getargs
  99.     call qdiv
  100.     jmp  putarg
  101.  
  102. lmod:    call getargs
  103.     call qmod
  104.     jmp  putarg
  105.  
  106. ;getargs gets arg3 into u, arg4 into (BCDE)
  107.  
  108. getargs:
  109.     call ma5toh        ;get ptr to arg3 (note use ma5 cause of 
  110.                 ;return addr on stack)
  111.     call qld        ;arg3 now in (BCDE)
  112.     lxi  h,u
  113.     call qst        ;now in u
  114.     call ma6toh        ;get ptr to arg4
  115.     jmp  qld        ;arg4 now in (BCDE)
  116.  
  117.  
  118. ; putarg copies (BCDE) into result arg (arg2) and cleans up
  119.  
  120. putarg:    call ma3toh        ;get pointer to arg2
  121.     call qst        ;copy (BCDE) into it
  122.     pop  b            ;restore BC for caller
  123.     ret
  124.  
  125.  
  126.  
  127. ; quad subtraction  u - (BCDE) -> (BCDE)
  128.  
  129. qsub:    call qneg      ;complement (BCDE) and fall thru to add
  130.  
  131. ; quad addition     u + (BCDE) -> (BCDE)
  132.  
  133. qadd:   push h
  134.     lxi  h,u+3    ;tenSHUN
  135.     mov  a,m    ;hup
  136.     add  e        ;two
  137.     mov  e,a    ;three
  138.     dcx  h        ;four
  139.     mov  a,m    ;hup
  140.     adc  d        ;two
  141.     mov  d,a    ;three
  142.     dcx  h        ;four
  143.     mov  a,m    ;hup
  144.     adc  c        ;two
  145.     mov  c,a    ;three
  146.     dcx  h        ;four
  147.     mov  a,m    ;hup
  148.     adc  b        ;two
  149.     mov  b,a    ;three
  150.     pop  h        ;four
  151.     ret        ;at ease    
  152.     
  153.  
  154. ; two's complement (BCDE)
  155.  
  156. qneg:    push h
  157.     xra  a
  158.     mov  l,a
  159.     sbb  e
  160.     mov  e,a
  161.     mov  a,l
  162.     sbb  d
  163.     mov  d,a
  164.     mov  a,l
  165.     sbb  c
  166.     mov  c,a
  167.     mov  a,l
  168.     sbb  b
  169.     mov  b,a
  170.     pop  h
  171.     ret
  172.  
  173.  
  174. qneghl: push b
  175.     push d
  176.     call qld
  177.     call qneg
  178.     call qst
  179.     pop  d
  180.     pop  b
  181.     ret
  182.  
  183. ; signed quad multiplication
  184. ; u * (BCDE) --> (BCDE)
  185.  
  186. qmul:    call csign            ;take abs values and compute signs
  187.     push psw            ;save result sign
  188.     call uqmul            ;compute product
  189. qmul1:    pop  psw
  190.     jm   qneg            ;complement product if needed
  191.     ret
  192.  
  193. ; csign takes abs vals of u, (BCDE), and computes product of their signs
  194.  
  195. csign:    mov  a,b            ;look at (BCDE) first
  196.     ora  a
  197.     push psw            ;save flags
  198.     cm   qneg            ;complement if needed
  199.     lxi  h,u            ;now look at u
  200.     mov  a,m
  201.     ora  a
  202.     jp   csign1
  203.     call qneghl
  204.     pop  psw
  205.     xri  80h            ;flip sign
  206.     ret
  207. csign1:    pop psw
  208.     ret
  209.  
  210. ; unsigned quad multiplication 
  211. ; u * (BCDE) --> (BCDE)        (expects ptr. to u in (HL)
  212.  
  213. uqmul:    lxi  h,u
  214.     push h                ;put pointer to u on stack
  215.     lxi  h,mq
  216.     call qst            ;(BCDE) -> mq
  217.     lxi  b,0            ;init product to 0
  218.     lxi  d,0
  219. uqmul1:    call qtsthl            ;test if mq is 0
  220.     jz   uqmul2            ;if so, done
  221.     xra  a                ;clear carry
  222.     call qrarhl            ;shift mq over
  223.     cc   qadd            ;add u to (BCDE) if lsb=1
  224.     xthl                ;get pointer to u
  225.     xra  a                ;clear carry
  226.     call qralhl            ;double u
  227.     xthl                ;get back pointer to mq
  228.     jmp  uqmul1
  229. uqmul2:    pop  h                ;restore stack
  230.     ret
  231.  
  232. ; signed division  u / (BCDE) --> (BCDE)
  233.  
  234. qdiv:    call qtst            ;first test for zero divisor
  235.     rz
  236.     call csign            ;take care of signs
  237.     push psw            ;save quotient sign
  238.     call uqdiv
  239.     call qld            ;get quotient in (BCDE)
  240.     jmp  qmul1            ;adjust sign of result
  241.  
  242. ;  signed remainder  u mod (BCDE) --> (BCDE)
  243.  
  244. qmod:    call qtst            ;test for zero modulus
  245.     rz
  246.     lda  u                ;sign of u is that of result
  247.     ora  a
  248.     push psw            ;save flags
  249.     call csign            ;get abs val of args
  250.     call uqdiv            ;remainder in (BCDE)
  251.     jmp  qmul1
  252.  
  253.  
  254. ;  unsigned division  u / (BCDE) --> mq, remainder in (BCDE)
  255.  
  256.  
  257.  
  258. uqdiv:    lxi  h,mq            ;mq will contain quotient
  259.     call qclrhl            ;clear it
  260.     push h                ;save it on the stack
  261.  
  262.     mvi  l,1            ;now normalize divisor
  263. uqdiv1:    mov  a,b            ;look at most signif non-sign bit
  264.     ani  40h
  265.     jnz   uqdiv2
  266.     call qral            ;if not 1, shift left
  267.     inr  l
  268.     jmp  uqdiv1
  269. uqdiv2:    mov  a,l
  270.     sta  temp            ;save normalization count
  271.     lxi  h,u            
  272.     call qxchg            ;want divid in (BCDE), divisor in u
  273.     xthl                ;pointer to mq in (HL), u on stack
  274.  
  275. ;main loop
  276.  
  277. uqdiv3: call trial            ;trial subtraction of divisor
  278.     call qralhl            ;shift in the carry
  279.     lda  temp            ;get the count
  280.     dcr  a
  281.     jz   uqdiv4            ;done
  282.     sta  temp            ;save count again
  283.     xthl                ;divisor in (HL)
  284.     xra  a
  285.     call qrarhl            ;shift it right one
  286.     xthl                ;quotient in (HL)
  287.     jmp  uqdiv3
  288.  
  289. uqdiv4: inx  sp
  290.     inx  sp                ;clean off top of stack
  291.     ret
  292.  
  293.  
  294. trial:    call qsub            ;subtract divid from divisor
  295.     call qneg            ;actually want divisor from divid
  296.     stc                ;assume was positive
  297.     rp
  298.     call qadd            ;else must restore dividend
  299.     xra  a                ;clear carry
  300.     ret
  301.  
  302.  
  303. ;
  304. ; routines to manipulate quads
  305. ;
  306. ; qld loads the quad pointed to by (HL) into (BCDE)
  307.  
  308. qld:    push h
  309.     mov  b,m
  310.     inx  h
  311.     mov  c,m
  312.     inx  h
  313.     mov  d,m
  314.     inx  h
  315.     mov  e,m
  316.     pop  h
  317.     ret
  318.  
  319. ; qst is inverse of qld
  320.  
  321. qst:    push h
  322.     mov  m,b
  323.     inx  h
  324.     mov  m,c
  325.     inx  h
  326.     mov  m,d
  327.     inx  h
  328.     mov  m,e
  329.     pop  h
  330.     ret
  331.  
  332.  
  333.  
  334. ; rotate  (BCDE) right thru carry
  335.  
  336. qrar:    mov a,b
  337.     rar
  338.     mov b,a
  339.     mov a,c
  340.     rar
  341.     mov c,a
  342.     mov a,d
  343.     rar
  344.     mov d,a
  345.     mov a,e
  346.     rar
  347.     mov e,a
  348.     ret
  349.  
  350. ; same for quad pointed to by (HL)
  351.  
  352. qrarhl:    push h
  353.     mov  a,m
  354.     rar
  355.     mov  m,a
  356.     inx  h
  357.     mov  a,m
  358.     rar
  359.     mov  m,a
  360.     inx  h
  361.     mov  a,m
  362.     rar
  363.     mov  m,a
  364.     inx  h
  365.     mov  a,m
  366.     rar
  367.     mov  m,a
  368.     pop  h
  369.     ret
  370.  
  371.  
  372. ; rotate (BCDE) left thru carry
  373.  
  374. qral:    mov a,e
  375.     ral
  376.     mov e,a
  377.     mov a,d
  378.     ral
  379.     mov d,a
  380.     mov a,c
  381.     ral
  382.     mov c,a
  383.     mov a,b
  384.     ral
  385.     mov b,a
  386.     ret
  387.  
  388. ; qralhl does it for quad pointed to by (HL)
  389.  
  390. qralhl:    inx  h
  391.     inx  h
  392.     inx  h                ;get to rightmost byte
  393.     mov  a,m
  394.     ral
  395.     mov  m,a
  396.     dcx  h
  397.     mov  a,m
  398.     ral
  399.     mov  m,a
  400.     dcx  h
  401.     mov  a,m
  402.     ral
  403.     mov  m,a
  404.     dcx  h
  405.     mov  a,m
  406.     ral
  407.     mov  m,a
  408.     ret
  409.     
  410.  
  411. ;qclrhl clears quad pointed to by (HL)
  412.  
  413. qclrhl:    push h
  414.     xra  a
  415.     mov  m,a
  416.     inx  h
  417.     mov  m,a
  418.     inx  h
  419.     mov  m,a
  420.     inx  h
  421.     mov  m,a
  422.     pop  h
  423.     ret
  424.  
  425.  
  426. ; qtst tests sign of (BCDE), setting the usual flags
  427.  
  428. qtst:    mov  a,b            ;look at most signif byte
  429.     ora  a
  430.     rnz
  431.     ora  c                ;test for zero
  432.     ora  d
  433.     ora  e
  434. qtst1:    rp
  435.     mvi  a,1
  436.     ora  a  
  437.     ret
  438.     
  439. qtsthl:    mov  a,m
  440.     ora  a
  441.     rnz
  442.     push h
  443.     inx  h
  444.     ora  m
  445.     inx  h
  446.     ora  m
  447.     inx  h
  448.     ora  m
  449.     pop  h
  450.     jmp  qtst1
  451.  
  452. ; swap (BCDE) with thing pointed to by HL
  453.  
  454. qxchg:    push h
  455.     mov  a,m
  456.     mov  m,b
  457.     mov  b,a
  458.     inx  h
  459.     mov  a,m
  460.     mov  m,c
  461.     mov  c,a
  462.     inx  h
  463.     mov  a,m
  464.     mov  m,d
  465.     mov  d,a
  466.     inx  h
  467.     mov  a,m
  468.     mov  m,e
  469.     mov  e,a
  470.     pop  h
  471.     ret
  472.  
  473.  
  474.  ENDFUNCTION
  475.  
  476.  
  477.  
  478.