home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol133 / byteops.src < prev    next >
Encoding:
Text File  |  1984-04-29  |  7.2 KB  |  310 lines
  1. ; Byte add/subtract procedures for new floating point package
  2.  
  3. ; function byteadd( var carry: carrytyp; a, b: byte ): byte; external;
  4.  
  5.     entry   byteadd
  6.  
  7. byteadd pop    h        ; hl := return address
  8.     pop    b        ; b := first operand, c := second operand
  9.     inx    s        ; Skip over length byte.
  10.     pop    d        ; de := address of the carry flag
  11.     ldax    d        ; a := carry flag
  12.     cpi    1
  13.     cmc            ; carry := not carry
  14.     mov    a,b
  15.     adc    c        ; a := a + c + carry
  16.     mov    b,a
  17.     mvi    a,0
  18.     jrnc    NoCarry     ; Branch if carry = 0
  19.     mvi    a,1
  20. NoCarry stax    d        ; Set passed carry flag to correct value.
  21.     xra    a
  22.     mov    d,a
  23.     mov    e,b
  24.     pchl
  25.  
  26. ; function bytesub( var carry: carrytyp; a, b: byte ): byte; external;
  27.  
  28.     entry   bytesub
  29.  
  30. bytesub pop     h
  31.     pop    b        ; b := first operand, c := second operand
  32.     inx    s        ; Skip over length byte.
  33.     pop    d        ; de := address of the carry flag
  34.     ldax    d        ; a := carry flag
  35.     cpi    1
  36.     cmc            ; carry := not carry
  37.     mov    a,b
  38.     sbb    c        ; a := a - c - carry
  39.     mov    b,a
  40.     mvi    a,0
  41.     jrnc    NoCar        ; Branch if carry = 0
  42.     mvi    a,1
  43. NoCar    stax    d        ; Set passed carry flag to correct value.
  44.     xra    a
  45.     mov    d,a
  46.     mov    e,b
  47.     pchl
  48.  
  49. ; Byte type 1 mult procedure for new floating point package
  50.  
  51. ;function byt1mul(var carr : byte; mcand, mlier : byte) : byte; external;
  52.  
  53. haddr11:equ    12        ; high byte of carry address
  54. laddr11:equ    11        ; low byte of carry address
  55. ;length of call-by-ref carry stored in position 10
  56. mcand1:    equ     9
  57. mlier1:    equ     8
  58. result:    equ     2
  59.  
  60.     entry    byt1mul
  61. byt1mul:entr    d,2,0
  62.     mov    h,a
  63.     mov    l,mcand1(ix)
  64.     mov     d,a
  65.     mov    e,mlier1(ix)
  66.  
  67.     mvi    a,9        ; only do 9 shifts
  68.     mov    d,e
  69.     mov    b,h        ; copy hl -> bc
  70.     mov    c,l
  71.     lxi    h,0        ; clear result
  72.  
  73. mloop1:    dcr    a        ; check shift counter
  74.     jrz    mdone1
  75.     dad    h        ; shift partial result
  76.     slar    e        ; shift multiplier
  77.     rlar    d
  78.     jrnc    mloop1        ; next shift
  79.     dad    b        ; add in multiplicand
  80.     jr    mloop1
  81.  
  82. mdone1:    mov    d,haddr11(ix)    ; get hi byte of carry addr
  83.     mov    e,laddr11(ix)    ; get lo byte of carry addr
  84.     ldax     d        ; get carry
  85.     mvi     d,0
  86.     mov    e,a
  87.     dad    d        ; add in carry
  88.  
  89.     mov    result(ix),l    ; store result
  90.  
  91.     mov    d,haddr11(ix)    ; get hi byte of carry addr
  92.     mov    e,laddr11(ix)    ; get lo byte of carry addr
  93.     mov    a,h
  94.     stax    d        ; store carry
  95.  
  96.     exit    d,5        ; done, five bytes of parameters
  97.  
  98. ; Byte mult procedure for new floating point package
  99.  
  100. ;procedure bytemul(var carr, pprod : byte; mcand, mlier : byte); external;
  101.  
  102. haddr1:    equ    15        ; high byte of carry address
  103. laddr1:    equ    14        ; low byte of carry address
  104. ;length of call-by-ref carry stored in position 13
  105. haddr2:    equ    12        ; high byte of partial product addr
  106. laddr2:    equ    11        ; low byte of partial product addr
  107. ;length of call-by-ref partial prod stored in position 10
  108. mcand:    equ     9        ; multiplicand byte
  109. mlier:    equ     8        ; multiplier byte
  110.  
  111.     entry    bytemul
  112. bytemul:entr    d,2,0
  113.     mov    h,a
  114.     mov    l,mcand(ix)
  115.     mov     d,a
  116.     mov    e,mlier(ix)
  117.  
  118.     mvi    a,9        ; only do 9 shifts
  119.     mov    d,e
  120.     mov    b,h        ; copy hl -> bc
  121.     mov    c,l
  122.     lxi    h,0        ; clear result
  123.  
  124. mloop:    dcr    a        ; check shift counter
  125.     jrz    mdone        
  126.     dad    h        ; shift partial result
  127.     slar    e        ; shift multiplier
  128.     rlar    d
  129.     jrnc    mloop        ; next shift
  130.     dad    b        ; add in multiplicand
  131.     jr    mloop
  132.  
  133. mdone:    mov    d,haddr2(ix)    ; get hi byte of pproduct addr
  134.     mov    e,laddr2(ix)    ; get lo byte of pproduct addr
  135.     ldax    d        ; get partial product
  136.     mvi    d,0
  137.     mov    e,a
  138.     dad    d        ; add in partial product
  139.  
  140.     mov    d,haddr1(ix)    ; get hi byte of carry addr
  141.     mov    e,laddr1(ix)    ; get lo byte of carry addr
  142.     ldax     d        ; get carry
  143.     mvi     d,0
  144.     mov    e,a
  145.     dad    d        ; add in carry
  146.  
  147.     mov    d,haddr2(ix)    ; get hi byte of pproduct addr
  148.     mov    e,laddr2(ix)    ; get lo byte of pproduct addr
  149.     mov    a,l
  150.     stax     d        ; store partial product
  151.  
  152.     mov    d,haddr1(ix)    ; get hi byte of carry addr
  153.     mov    e,laddr1(ix)    ; get lo byte of carry addr
  154.     mov    a,h
  155.     stax    d        ; store carry
  156.  
  157.     exit    d,8        ; done, eight bytes of parameters
  158.  
  159. ;BYTE MARK 1 DIV PROCEDURE FOR NEW FLOATING POINT PACKAGE
  160. ;REPRESENTS A MODIFICATION OF BYTEDIV TO SUIT THE PROCEDURE DIVD
  161. ;NEEDS CAREFUL EVALUATION FOR APPLICABILITY TO OTHER CONTEXTS
  162.  
  163. ;PROCEDURE BYT1DIV(VAR REM2, QUOT2 : BYTE; NUM1, NUM2, DEN : BYTE);
  164. ;EXTERNAL;
  165.  
  166. HADRR2:    EQU    16        ; HIGH BYTE OF REM2 ADDRESS
  167. LADRR2:    EQU    15        ; LOW BYTE OF REM2 ADDRESS
  168. ;LENGTH OF CALL-BY-REF REM2 STORED IN POSITION 14
  169. HADRQ2:    EQU    13        ; HIGH BYTE OF QUOT2 ADDRESS
  170. LADRQ2:    EQU    12        ; LOW BYTE OF QUOT2 ADDRESS
  171. ;LENGTH OF CALL-BY-REF QUOT2 STORED IN POSITION 11
  172. NUMER1:    EQU    10
  173. NUMER2:    EQU     9
  174. DENOM:    EQU     8
  175.  
  176.     ENTRY    BYT1DIV
  177. BYT1DIV:ENTR    D,2,0
  178.     MOV    H,NUMER1(IX)
  179.     MOV    L,NUMER2(IX)
  180.     MOV    D,A
  181.     MOV    E,DENOM(IX)
  182.  
  183. ;NORMALIZE THE DIVISOR, KEEPING COUNT OF THE NUMBER
  184. ;OF SHIFTS REQUIRED TO ACCOMPLISH THIS
  185.  
  186.     XCHG        ;IT'S EASIER TO SHIFT HL
  187. CKNM2:    BIT    6,H
  188.     JRNZ    NORMAL
  189.     INR    A
  190.     DAD    H    ;SHIFT DIVISOR LEFT ONE BIT
  191.     JMP    CKNM2
  192.  
  193. NORMAL: XCHG        ;RESTORE DIVISOR TO DE
  194.     LXI    B,0H
  195.     INR    A
  196.  
  197. ;DIVIDE LOOP
  198. DIVLOOP:ORA    A    ;CLEAR CARRY
  199.     DSBC    D    ;ATTEMPT SUBTRACTION
  200.     CMC
  201.     JC    PASSED    ;CARRY MEANS WE SHIFT A ONE
  202.     DAD    D    ;FAIL -- RESTORE DIVIDEND, CARRY <- 0
  203.     ORA    A
  204. PASSED:    RLAR    C    ;SHIFT 0 OR 1 INTO QUOTIENT
  205.     RLAR    B
  206.     SRAR    D    ;SHIFT DIVISOR
  207.     RRAR    E
  208.     DCR    A
  209.     JNZ    DIVLOOP
  210.  
  211. ;DONE DIVISION IS COMPLETE
  212. ;THE MAGNITUDE OF THE REMAINDER IS IN HL
  213. ;THE MAGNITUDE OF THE ANSWER IS IN BC
  214.  
  215.     MOV    D,HADRR2(IX)    ;GET HI BYTE OF REM2 ADDRESS
  216.     MOV    E,LADRR2(IX)    ;GET LO BYTE OF REM2 ADDRESS
  217.     MOV    A,L
  218.     STAX    D        ;STORE REM2
  219.  
  220.     MOV    D,HADRQ2(IX)    ;GET HI BYTE OF QUOT2 ADDRESS
  221.     MOV    E,LADRQ2(IX)    ;GET LO BYTE OF QUOT2 ADDRESS
  222.     MOV    A,C
  223.     STAX    D        ;STORE QUOT2
  224.  
  225.     EXIT    D,9        ;DONE, NINE BYTES OF PARAMETERS
  226. ;BYTE DIV PROCEDURE FOR NEW FLOATING POINT PACKAGE
  227. ;ASSUMES THE DIVIDEND TO BE A TWO-BYTES NUMBER AND THE DIVISOR A 
  228. ;ONE-BYTE NUMBER
  229.  
  230. ;PROCEDURE BYTEDIV(VAR REM1, REM2, QUOT1, QUOT2 : BYTE;
  231. ;NUM1, NUM2, DEN : BYTE); EXTERNAL;
  232.  
  233. HADDRR1:EQU    22        ; HIGH BYTE OF REM1 ADDRESS
  234. LADDRR1:EQU    21        ; LOW BYTE OF REM1 ADDRESS
  235. ;LENGTH OF CALL-BY-REF REM1 STORED IN POSITION 20
  236. HADDRR2:EQU    19        ; HIGH BYTE OF REM2 ADDRESS
  237. LADDRR2:EQU    18        ; LOW BYTE OF REM2 ADDRESS
  238. ;LENGTH OF CALL-BY-REF REM2 STORED IN POSITION 17
  239. HADDRQ1:EQU    16        ; HIGH BYTE OF QUOT1 ADDRESS
  240. LADDRQ1:EQU    15        ; LOW BYTE OF QUOT1 ADDRESS
  241. ;LENGTH OF CALL-BY-REF QUOT1 STORED IN POSITION 14
  242. HADDRQ2:EQU    13        ; HIGH BYTE OF QUOT2 ADDRESS
  243. LADDRQ2:EQU    12        ; LOW BYTE OF QUOT2 ADDRESS
  244. ;LENGTH OF CALL-BY-REF QUOT2 STORED IN POSITION 11
  245. NUM1:    EQU    10
  246. NUM2:    EQU     9
  247. DEN:    EQU     8
  248.  
  249.     ENTRY    BYTEDIV
  250. BYTEDIV:ENTR    D,2,0
  251.     MOV    H,NUM1(IX)
  252.     MOV    L,NUM2(IX)
  253.     MOV    D,A
  254.     MOV    E,DEN(IX)
  255.  
  256. ;NORMALIZE THE DIVISOR, KEEPING COUNT OF THE NUMBER
  257. ;OF SHIFTS REQUIRED TO ACCOMPLISH THIS
  258.  
  259.     XCHG        ;IT'S EASIER TO SHIFT HL
  260. CKNM1:    BIT    6,H
  261.     JRNZ    NORM
  262.     INR    A
  263.     DAD    H    ;SHIFT DIVISOR LEFT ONE BIT
  264.     JMP    CKNM1
  265.  
  266. NORM:    XCHG        ;RESTORE DIVISOR TO DE
  267.     LXI    B,0H
  268.     INR    A
  269.  
  270. ;DIVIDE LOOP
  271. DIVLOP:    ORA    A    ;CLEAR CARRY
  272.     DSBC    D    ;ATTEMPT SUBTRACTION
  273.     CMC
  274.     JC    PASS    ;CARRY MEANS WE SHIFT A ONE
  275.     DAD    D    ;FAIL -- RESTORE DIVIDEND, CARRY <- 0
  276.     ORA    A
  277. PASS:    RLAR    C    ;SHIFT 0 OR 1 INTO QUOTIENT
  278.     RLAR    B
  279.     SRAR    D    ;SHIFT DIVISOR
  280.     RRAR    E
  281.     DCR    A
  282.     JNZ    DIVLOP
  283.  
  284. ;DONE DIVISION IS COMPLETE
  285. ;THE MAGNITUDE OF THE REMAINDER IS IN HL
  286. ;THE MAGNITUDE OF THE ANSWER IS IN BC
  287.  
  288.     MOV    D,HADDRR1(IX)    ;GET HI BYTE OF REM1 ADDRESS
  289.     MOV    E,LADDRR1(IX)    ;GET LO BYTE OF REM1 ADDRESS
  290.     MOV    A,H
  291.     STAX    D        ;STORE REM1
  292.  
  293.     MOV    D,HADDRR2(IX)    ;GET HI BYTE OF REM2 ADDRESS
  294.     MOV    E,LADDRR2(IX)    ;GET LO BYTE OF REM2 ADDRESS
  295.     MOV    A,L
  296.     STAX    D        ;STORE REM2
  297.  
  298.     MOV    D,HADDRQ1(IX)    ;GET HI BYTE OF QUOT1 ADDRESS
  299.     MOV    E,LADDRQ1(IX)    ;GET LO BYTE OF QUOT1 ADDRESS
  300.     MOV    A,B
  301.     STAX     D        ;STORE QUOT1
  302.  
  303.     MOV    D,HADDRQ2(IX)    ;GET HI BYTE OF QUOT2 ADDRESS
  304.     MOV    E,LADDRQ2(IX)    ;GET LO BYTE OF QUOT2 ADDRESS
  305.     MOV    A,C
  306.     STAX    D        ;STORE QUOT2
  307.  
  308.     EXIT    D,15        ;DONE, FIFTEEN BYTES OF PARAMETERS
  309.  
  310.