home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / ASM / COMMONIO.ASM < prev    next >
Encoding:
Assembly Source File  |  1992-11-18  |  7.2 KB  |  272 lines

  1. ;* COMMONIO.ASM
  2. ;************************************************************************
  3. ;*                                    *
  4. ;*        PC Scheme/Geneva 4.00 Borland TASM code            *
  5. ;*                                    *
  6. ;* (c) 1985-1988 by Texas Instruments, Inc. See COPYRIGHT.TXT        *
  7. ;* (c) 1992 by L. Bartholdi & M. Vuilleumier, University of Geneva    *
  8. ;*                                    *
  9. ;*----------------------------------------------------------------------*
  10. ;*                                    *
  11. ;*        Integer & float printing interfaces            *
  12. ;*                                    *
  13. ;*----------------------------------------------------------------------*
  14. ;*                                    *
  15. ;* Created by: John Jensen        Date: 1985            *
  16. ;* Revision history:                            *
  17. ;* - 18 Jun 92:    Renaissance (Borland Compilers, ...)            *
  18. ;*                                    *
  19. ;*                    ``In nomine omnipotentii dei''    *
  20. ;************************************************************************
  21. IDEAL
  22. %PAGESIZE    60, 132
  23. MODEL   medium
  24. LOCALS    @@
  25.  
  26.     INCLUDE    "scheme.ash"
  27.  
  28. CODESEG
  29. ;************************************************************************
  30. ;* Find approximate space left on stack (assume Bot of Stack at DS:FFFF)*
  31. ;*    Caling sequence: stkspc()                    *
  32. ;************************************************************************
  33. PROC C    stkspc
  34. DATASEG
  35.     EXTRN    C _stklen:WORD        ; total length of runtime stack
  36. CODESEG
  37.     mov    ax, [_stklen]
  38.     add    ax, sp
  39.     ret
  40. ENDP    stkspc
  41.  
  42. ;************************************************************************
  43. ;* Parse input integer                            *
  44. ;* Calling sequence: buildint(work,buf,base)                *
  45. ;* Where work:    pointer to some workspace                *
  46. ;*     buf:    pointer to integer characters                *
  47. ;*     base:    numeric base                        *
  48. ;************************************************************************
  49. PROC C    buildint USES si di, @@bignum:WORD, @@charbuf:WORD, $$base:WORD
  50.     push    ds            ; Assume es = ds
  51.     pop    es
  52.     cld
  53.     mov    si, [@@charbuf]
  54.     lodsb                ; Fetch first character
  55.     cmp    al, '-'
  56.     pushf
  57.     je    @@negative
  58.     cmp    al, '+'
  59.     je    @@negative
  60.     dec    si            ; Point si back to first char
  61. @@negative:
  62.     mov    cx, 1            ; At first, bignum is one word
  63.     add    [@@bignum], 3        ; Point BIGPTR to bignum proper
  64. @@skipbase:
  65.     lodsb                ; Get first number char
  66.     cmp    al, '#'            ; we know the base - skip all #x's
  67.     jne    @@skipped
  68.     inc    si
  69.     jmp    @@skipbase
  70. @@readloop:
  71.     lodsb                ; Get next int character
  72. @@skipped:
  73.     mov    di, [@@bignum]
  74.     sub    al, '0'
  75.     js    @@numberdone
  76.     cmp    al, 9
  77.     jbe    @@plaindigit
  78.     and    al, 7        ;Otherwise, parse extra hex digit
  79.     add    al, 9
  80. @@plaindigit:
  81.     xor    ah, ah
  82.     call    bigx10        ;Multiply bignum by 10, adding digit
  83.     jmp    @@readloop
  84.  
  85. @@numberdone:
  86.     sub    di, 3        ; Point di back to start of buffer
  87.     mov    ax, cx        ; Save integer size
  88.     stosw
  89.     xor    al, al
  90.     popf            ; Get number's sign
  91.     jne    @@storesign
  92.     inc    al
  93. @@storesign:
  94.     mov    [di], al
  95.     ret
  96. ENDP    buildint
  97.  
  98. ;************************************************************************
  99. ;* BIGX10: Multiply bignum at es:[di], size=cx words, by BASE and add ax*
  100. ;************************************************************************
  101. PROC    bigx10    NEAR
  102.     push    cx
  103.     mov    dx, ax        ; Transfer digit to add
  104.     cld
  105. @@loop:
  106.     mov    ax, [di]    ; Get word to multiply
  107.     call    wordx10        ; Multiply word by 10
  108.     stosw
  109.     loop    @@loop
  110.     pop    cx
  111.     or    dx, dx        ; Does a carry remain?
  112.     jz    @@samelength
  113.     mov    [es:di], dx    ; enlarge bignum
  114.     inc    cx
  115. @@samelength:
  116.     ret
  117. ENDP    bigx10
  118.  
  119. ;************************************************************************
  120. ;* WORDX10: Multiply ax by BASE and add dx                *
  121. ;*        product in ax, carry in dx                *
  122. ;************************************************************************
  123. PROC    wordx10    NEAR
  124.     push    cx dx        ; Save value of cx, carry in
  125.     mul    [$$base]
  126.     pop    cx        ; Restore carry to cx
  127.     add    ax, cx        ; Add carry
  128.     adc    dx, 0
  129.     pop    cx        ; Restore cx
  130.     ret
  131. ENDP    wordx10
  132.  
  133. ;************************************************************************
  134. ;*        Copy bignum data to a math buffer            *
  135. ;*    Calling sequence: copybig(pg,ds,buf)                *
  136. ;* Where:    pg,ds ---- page & displacement of bignum        *
  137. ;*        buf ------ pointer to math buffer            *
  138. ;************************************************************************
  139. PROC C    copybig    USES ds si di, @@page:WORD, @@disp:WORD, @@buffer:WORD
  140.     push    ds            ; Assume es = ds
  141.     pop    es
  142.     mov    si, [@@page]
  143.     sal    si, 1
  144.     ldpage    ds, si
  145.     mov    si, [@@disp]
  146.     mov    ax, [si+1]        ; Get size of bignum proper (words)
  147.     sub    ax, 4
  148.     shr    ax, 1
  149.     add    si, 3            ; Point ds:si to sign byte
  150.     mov    di, [@@buffer]
  151.     cld                ; Direction forward
  152.     stosw                ; Store bignum size in math buffer
  153.     movsb                ; Copy sign byte
  154.     mov    cx, ax
  155.     rep    movsw
  156.     ret
  157. ENDP    copybig
  158.  
  159. ;************************************************************************
  160. ;*        Convert buffered bignum to ASCII            *
  161. ;*    Calling sequence: big2asc(mathbuf,charbuf)            *
  162. ;* Where:    mathbuf --- pointer to buffered bignum            *
  163. ;*        charbuf --- pointer to ASCII charcater array        *
  164. ;************************************************************************
  165. PROC C    big2asc    USES si di, @@math:WORD, @@chars:WORD
  166.     push    ds            ; Assume es = ds
  167.     pop    es
  168.     mov    si, [@@math]
  169.     mov    di, [@@chars]
  170.     cld
  171.     lodsw                ; Fetch bignum size
  172.     mov    cx, ax
  173.     lodsb                ; Fetch sign
  174.     test    al, 1
  175.     jz    @@positive
  176.     mov    al, '-'            ; first character: minus
  177.     stosb
  178. @@positive:
  179.     mov    bx, 10
  180.     and    ax, 1            ; Push 0 or 1 (1 if start with -)
  181. @@loop:
  182.     push    ax
  183.     call    divbig
  184.     mov    al, dl
  185.     add    al, '0'
  186.     stosb
  187.     pop    ax            ; Increment character counter
  188.     inc    ax
  189.     or    cx, cx            ; Loop until bignum is zeroed
  190.     jnz    @@loop
  191.     mov    cx, ax
  192.     push    ax
  193.     sub    di, cx            ; Point di to beginning of string
  194.     call    reverse
  195.     pop    ax            ; Restore character count
  196.     ret
  197. ENDP    big2asc
  198.  
  199. ;************************************************************************
  200. ;* Divide bignum at ds:si, length cx words, by bx (es=ds)        *
  201. ;************************************************************************
  202. PROC    divbig    NEAR
  203.     push    cx di
  204.     add    si, cx        ; Point si to last word (most signif.)
  205.     add    si, cx
  206.     sub    si, 2
  207.     cmp    [si], bx    ; Will working length be reduced?
  208.     pushf
  209.     mov    di, si        ; es:di = ds:si
  210.     std                ;Direction backward
  211.     xor    dx, dx        ; Clear carry in
  212. @@loop:
  213.     lodsw
  214.     div    bx
  215.     stosw
  216.     loop    @@loop
  217.     add    si, 2        ; Point si again to first word
  218.     popf
  219.     pop    di cx
  220.     jae    @@nounderflow
  221.     dec    cx
  222. @@nounderflow:
  223.     ret            ; Remainder left in dx
  224. ENDP    divbig
  225.  
  226. ;************************************************************************
  227. ;* Reverse the string containing cx characters at es:di (es=ds)        *
  228. ;************************************************************************
  229. PROC    reverse    NEAR
  230.     cmp    [BYTE di], '-'
  231.     jne    @@positive
  232.     inc    di        ; Otherwise, don't include minus in reverse
  233.     dec    cx
  234. @@positive:
  235.     mov    si, di        ; Point si to last string char
  236.     add    si, cx
  237.     dec    si
  238.     shr    cx, 1        ; Number of switches
  239.     jcxz    @@done
  240. @@loop:
  241.     mov    al, [di]    ;Exchange outside bytes
  242.     xchg    al, [si]
  243.     stosb
  244.     dec    si        ;Move pointers inward
  245.     loop    @@loop
  246. @@done:
  247.     ret
  248. ENDP    reverse
  249.  
  250. ;************************************************************************
  251. ;* Is character a whitespace?                        *
  252. ;* Calling sequence: iswhitespace(ch)                    *
  253. ;* Where ch = character to check                    *
  254. ;* Returns zero iff not a whitespace                    *
  255. ;************************************************************************
  256. PROC C    iswhitespace, @@char:WORD
  257.     mov    ax, [@@char]
  258.     cmp    al, ' '
  259.     je    @@isspace
  260.     cmp    al, 9
  261.     jb    @@isnotspace
  262.     cmp    al, 13
  263.     jbe    @@isspace
  264. @@isnotspace:
  265.     xor    ax, ax        ; Set to zero
  266. @@isspace:
  267.     ret
  268. ENDP    iswhitespace
  269.  
  270.     END
  271.  
  272.