home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / microcode / osscheme.c < prev    next >
C/C++ Source or Header  |  2000-12-05  |  3KB  |  144 lines
  1. /* -*-C-*-
  2.  
  3. $Id: osscheme.c,v 1.11 2000/12/05 21:23:47 cph Exp $
  4.  
  5. Copyright (c) 1990-2000 Massachusetts Institute of Technology
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or (at
  10. your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful, but
  13. WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. */
  21.  
  22. #include "scheme.h"
  23. #include "prims.h"
  24. #include "osscheme.h"
  25.  
  26. extern void
  27.   EXFUN (signal_error_from_primitive, (long error_code));
  28.  
  29. void
  30. DEFUN_VOID (error_out_of_channels)
  31. {
  32.   signal_error_from_primitive (ERR_OUT_OF_FILE_HANDLES);
  33. }
  34.  
  35. void
  36. DEFUN_VOID (error_out_of_processes)
  37. {
  38.   signal_error_from_primitive (ERR_OUT_OF_FILE_HANDLES);
  39. }
  40.  
  41. void
  42. DEFUN_VOID (error_unimplemented_primitive)
  43. {
  44.   signal_error_from_primitive (ERR_UNDEFINED_PRIMITIVE);
  45. }
  46.  
  47. void
  48. DEFUN_VOID (error_floating_point_exception)
  49. {
  50.   signal_error_from_primitive (ERR_FLOATING_OVERFLOW);
  51. }
  52.  
  53. int
  54. DEFUN_VOID (executing_scheme_primitive_p)
  55. {
  56.   return (PRIMITIVE_P (Regs [REGBLOCK_PRIMITIVE]));
  57. }
  58.  
  59. #ifdef __OS2__
  60.  
  61. void
  62. DEFUN_VOID (request_attention_interrupt)
  63. {
  64.   REQUEST_INTERRUPT (INT_Global_1);
  65. }
  66.  
  67. int
  68. DEFUN_VOID (test_and_clear_attention_interrupt)
  69. {
  70.   long code;
  71.   GRAB_INTERRUPT_REGISTERS ();
  72.   code = (FETCH_INTERRUPT_CODE ());
  73.   CLEAR_INTERRUPT_NOLOCK (INT_Global_1);
  74.   RELEASE_INTERRUPT_REGISTERS ();
  75.   return ((code & INT_Global_1) != 0);
  76. }
  77.  
  78. #endif /* __OS2__ */
  79.  
  80. void
  81. DEFUN_VOID (request_character_interrupt)
  82. {
  83.   REQUEST_INTERRUPT (INT_Character);
  84. }
  85.  
  86. void
  87. DEFUN_VOID (request_timer_interrupt)
  88. {
  89.   REQUEST_INTERRUPT (INT_Timer);
  90. }
  91.  
  92. void
  93. DEFUN_VOID (request_suspend_interrupt)
  94. {
  95.   REQUEST_INTERRUPT (INT_Suspend);
  96.   return;
  97. }
  98.  
  99. int
  100. DEFUN_VOID (pending_interrupts_p)
  101. {
  102.   return (INTERRUPT_PENDING_P (INT_Mask));
  103. }
  104.  
  105. void
  106. DEFUN_VOID (deliver_pending_interrupts)
  107. {
  108.   if (INTERRUPT_PENDING_P (INT_Mask))
  109.     signal_interrupt_from_primitive ();
  110.   return;
  111. }
  112.  
  113. long
  114. DEFUN_VOID (get_interrupt_mask)
  115. {
  116.   return (FETCH_INTERRUPT_MASK ());
  117. }
  118.  
  119. void
  120. DEFUN (set_interrupt_mask, (mask), long mask)
  121. {
  122.   SET_INTERRUPT_MASK (mask & INT_Mask);
  123.   return;
  124. }
  125.  
  126. void
  127. DEFUN (debug_back_trace, (stream), outf_channel stream)
  128. {
  129.   outf (stream, "*** Scheme Microcode Back Trace: ***\n");
  130.   Back_Trace (stream);
  131.   outf (stream, "*** End of Back Trace ***\n");
  132.   outf_flush (stream);
  133.   return;
  134. }
  135.  
  136. void
  137. DEFUN (debug_examine_memory, (address, label),
  138.        long address AND
  139.        CONST char * label)
  140. {
  141.   Print_Expression ((* ((SCHEME_OBJECT *) address)), ((char *) label));
  142.   return;
  143. }
  144.