home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / ASM / PRINTATM.ASM < prev    next >
Encoding:
Assembly Source File  |  1992-11-18  |  4.9 KB  |  177 lines
  1. ;* PRINTATM
  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. ;*        Print an atom (interpreter support)            *
  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    small
  24. LOCALS    @@
  25.  
  26.     INCLUDE    "scheme.ash"
  27.     INCLUDE "interprt.ash"
  28.  
  29. CODESEG
  30. ;****************************************************************************
  31. ;    Print an S-Expression (w/ slashification)
  32. ; Purpose: Scheme interpreter support to output an s-expression to a port.
  33. ;****************************************************************************
  34. PROC    spprin1
  35.     get2op
  36.     save    <si>
  37.     xor    bx, bx
  38.     mov    bl, ah
  39.     add    bx, OFFSET regs     ; bx = port object
  40.     xor    ah, ah
  41.     add    ax, OFFSET regs     ; ax = s-expression pointer
  42.     mov    di, ax
  43.     mov    cx, 1             ; write indicator
  44.     call    get_port C, bx, cx     ; get port address
  45.     test    ax, ax             ; check return status
  46.     jz    @@ok
  47.     lea    bx, [@@msg]
  48. DATASEG
  49. @@msg    DB    "WRITE", 0
  50. CODESEG
  51.     jmp    src_err         ; link to error handler
  52. @@ok:
  53.     mov    [show], SP_OUTPUT or SP_SEPARE
  54. call_sprint:
  55.     mov    bx, [(REG di).page]
  56.     shr    bx, 1
  57.     call    sprint C, bx, [(REG di).disp], [tmp_reg.page], [tmp_reg.disp]
  58. ret_nonprintable:
  59.     mov    [(REG di).page], NPR_PAGE*2
  60.     mov    [(REG di).disp], NPR_DISP
  61.     jmp    next_pc
  62. ENDP    spprin1
  63.  
  64. ;****************************************************************************
  65. ;    Print an S-Expression (w/o slashification)
  66. ; Purpose: Scheme interpreter support to output an s-expression to a port.
  67. ;****************************************************************************
  68. PROC    spprinc
  69.     get2op
  70.     save    <si>
  71.     xor    bx, bx
  72.     mov    bl, ah
  73.     add    bx, OFFSET regs     ; bx = port object
  74.     xor    ah, ah
  75.     add    ax, OFFSET regs     ; ax = s-expression pointer
  76.     mov    di, ax
  77.     mov    cx, 1
  78.     push    es            ; save es over C call
  79.     call    get_port C, bx, cx    ; get port address
  80.     pop    es
  81.     test    ax, ax             ; check return status
  82.     jz    @@ok
  83.     lea    bx, [@@msg]
  84. DATASEG
  85. @@msg    DB    "DISPLAY", 0
  86. CODESEG
  87.     jmp    src_err
  88. @@ok:
  89.     mov    [show], SP_OUTPUT
  90.     jmp    call_sprint
  91. ENDP    spprinc
  92.  
  93. ;****************************************************************************
  94. ;    Print an S-Expression (w/ spacing control)
  95. ; Purpose: Scheme interpreter support to output an s-expression to a port.
  96. ;****************************************************************************
  97. PROC    spprint
  98.     get2op
  99.     save    <si>
  100.     xor    bx, bx
  101.     mov    bl, ah
  102.     add    bx, OFFSET regs     ; bx = port object
  103.     xor    ah, ah
  104.     add    ax, OFFSET regs     ; ax = s-expression pointer
  105.     mov    di, ax
  106.     mov    cx, 1
  107.     call    get_port C, bx, cx    ; get port address
  108.     test    ax, ax             ; check return status
  109.     jz    @@ok
  110.     lea    bx, [@@msg]
  111. DATASEG
  112. @@msg    DB    "PRINT", 0
  113. CODESEG
  114.     jmp    src_err
  115. @@ok:
  116.     mov    [show], SP_OUTPUT
  117.     mov    dx, SPECCHAR
  118.     mov    bx, LF             ; line feed
  119.     call    sprint C, dx, bx, [tmp_reg.page], [tmp_reg.disp]
  120.     mov    [show], SP_OUTPUT or SP_SEPARE
  121.     mov    bx, [(REG di).page]
  122.     shr    bx, 1
  123.     call    sprint C, bx, [(REG di).disp], [tmp_reg.page], [tmp_reg.disp]
  124.     mov    bx, SPACE
  125.     mov    dx, SPECCHAR
  126.     mov    [show], SP_OUTPUT
  127.     call    sprint C, dx, bx, [tmp_reg.page], [tmp_reg.disp]
  128.     jmp    ret_nonprintable
  129. ENDP    spprint
  130.  
  131. ;****************************************************************************
  132. ;    Print a "newline" character
  133. ; Purpose: Scheme interpreter support to output a newline character to a port.
  134. ;****************************************************************************
  135. PROC    spnewlin
  136.     get1op
  137.     save    <si>
  138.     add    ax, OFFSET regs     ; ax = port object
  139.     mov    cx, 1
  140.     call    get_port C, ax, cx     ; get port address
  141.     test    ax, ax             ; check return status
  142.     jz    @@ok
  143.     lea    bx, [@@msg]
  144. DATASEG
  145. @@msg    DB    "NEWLINE", 0
  146. CODESEG
  147.     jmp    src_err
  148. @@ok:
  149.     mov    [show], SP_OUTPUT
  150.     mov    bx, SPECCHAR
  151.     mov    dx, LF             ; linefeed
  152.     call    sprint C, bx, dx, [tmp_reg.page], [tmp_reg.disp]
  153.     jmp    next_pc
  154. ENDP    spnewlin
  155.  
  156. ;****************************************************************************
  157. ;    Find Print-length of an S-Expression
  158. ; Purpose: Scheme interpreter support to determine the print length of a scheme object.
  159. ;****************************************************************************
  160. PROC    prt_len
  161.     get1op
  162.     save    <si>
  163.     add    ax, OFFSET regs     ; ax = port object
  164.     mov    di, ax
  165.     mov    [show], 0
  166.     mov    dx, OUT_PAGE*2
  167.     mov    cx, OUT_DISP
  168.     mov    bx, [(REG di).page]
  169.     shr    bx, 1             ; correct page number
  170.     call    sprint C, bx, [(REG di).disp], dx, cx
  171.     mov    [(REG di).page], SPECFIX*2
  172.     mov    [(REG di).disp], ax ; get the print length
  173.     jmp    next_pc
  174. ENDP    prt_len
  175.     END
  176.  
  177.