globale.e 3.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169
  1. #include "e.h"
  2. exa .HTOP ; the label holtop
  3. exa .1 ; the Pascal global area
  4. exa _extfl ; the routine '_ini' puts 'input' & 'output' here
  5. exp $ESTART0
  6. exp $ESTART_
  7. exp $ESTOP_
  8. exp $ABORT
  9. ; PROCEDURE ESTART0
  10. pro $ESTART0,0
  11. lor 0 ; my LB
  12. dup SZADDR
  13. dch ; _m_a_i_n's LB
  14. dup SZADDR
  15. str 0 ; pretend I am in _m_a_i_n
  16. lae .HTOP-FIRSTIBOFFSET; destination address (holtop-firstiboffset)
  17. ; now calc how much to move
  18. lal 0
  19. lor 0
  20. sbs SZWORD ; subtract address of param from lb to get link space
  21. loc SZWORD+SZADDR+SZADDR
  22. ads SZWORD ; allow for one parameter of _m_a_i_n
  23. bls SZWORD ; block move
  24. ; now the global area contains an exact copy of
  25. ; _m_a_i_n's stack frame, and main will subsequently
  26. ; adjust its LB to point to this global copy, thus
  27. ; making it a part of the official stack.
  28. str 0 ; get my LB back
  29. ret 0
  30. end 0
  31. ; PROCEDURE ESTART_ (INPUT,OUTPUT);
  32. pro $ESTART_,0
  33. .2
  34. con 2,0,0 ; array that is to be _extfl
  35. .3
  36. con 0I SZADDR ; PASCAL trap routine
  37. .4
  38. con 0 ; trapn
  39. con 0 ; signaln
  40. LFL SZADDR+SZADDR ; base address for input (2nd param)
  41. lae .1
  42. sbs SZWORD ; subtract address from hol1 to get offset
  43. ste .2+SZWORD ; store in array of offsets
  44. LFL SZADDR ; and again for output (1st param after static link)
  45. lae .1
  46. sbs SZWORD
  47. ste .2+SZWORD+SZWORD ; store in array
  48. lxl 2 ; params for _ini
  49. lae .2
  50. lae .1
  51. lxa 2
  52. cal $_ini
  53. asp SZADDR+SZADDR+SZADDR+SZADDR
  54. loc A68STAMP ; _m_a_i_n's frame stamp, for isa68, any positive number
  55. ste .HTOP-FSTAMPOFFSET ; it is in a SZWORD integer, 1st local var
  56. inp $_usigs
  57. cal $_usigs ; catch UNIX interrupts as EM trap 15
  58. inp $_acatch
  59. lpi $_acatch ; A68 trap routine
  60. sig
  61. lae .3
  62. sti SZWORD ; preserve PASCAL trap routine
  63. zre .4 ; trapn
  64. ret 0
  65. end 0
  66. ; procedure usigs;
  67. ; var i: integer;
  68. ; begin
  69. ; for i := 1 to 16 do signal(i, ucatch);
  70. ; end;
  71. pro $_usigs,SZWORD
  72. mes 9,0
  73. loc 1
  74. loc 16
  75. bgt *2
  76. loc 1
  77. stl -SZWORD
  78. 1
  79. zer SZWORD
  80. inp $_ucatch
  81. lpi $_ucatch
  82. lol -SZWORD
  83. cal $signal
  84. asp SZWORD+SZWORD+SZWORD
  85. lol -SZWORD
  86. loc 16
  87. beq *2
  88. lol -SZWORD
  89. inc
  90. stl -SZWORD
  91. bra *1
  92. 2
  93. mes 3,-SZWORD,4,1
  94. ret 0
  95. end SZWORD
  96. ; procedure ucatch(signo: integer);
  97. ; begin
  98. ; trap(15);
  99. ; end;
  100. pro $_ucatch,0
  101. mes 9,4
  102. lol 0
  103. ste .4+SZWORD ; signaln
  104. #ifdef BSD4
  105. loc 0
  106. cal $sigsetmask ; unblock all signals
  107. asp SZWORD
  108. LLC 0 ; SIG_DFL
  109. lol 0
  110. cal $signal ; because 4.2 Inices do not reset caught signals
  111. asp SZADDR+SZWORD
  112. #endif
  113. loc 15
  114. cal $trap
  115. asp SZWORD
  116. mes 3,0,4,0
  117. ret 0
  118. end 0
  119. pro $_acatch,SZWORD
  120. loc PASCALSTAMP
  121. stl -SZWORD
  122. lol 0 ; EM trap number
  123. dup SZWORD
  124. ste .4 ; trapn
  125. ngi SZWORD
  126. lxl 0
  127. cal $ERRORR ; should never return
  128. end SZWORD
  129. pro $ESTOP_,0
  130. loc 0
  131. cal $_hlt
  132. end 0
  133. pro $ABORT,0
  134. loe .4 ; trapn
  135. zne *1
  136. loc 1 ; if abort is called then presumably some error has
  137. ; occured, thus exit code 1
  138. cal $_hlt
  139. 1
  140. loe .4 ; trapn
  141. loc 15
  142. bne *2 ; if not a UNIX signal
  143. cal $_cleanup
  144. loe .4+SZWORD ; signaln
  145. cal $getpid
  146. lfr SZWORD
  147. cal $kill
  148. 2
  149. lae .3 ; PASCAL trap routine
  150. loi SZWORD
  151. dup SZWORD
  152. zeq *3 ; no PASCAL trap routine
  153. sig
  154. asp SZWORD
  155. loe .4
  156. trp ; now let PASCAL handle the same trap
  157. 3
  158. loe .4 ; trapn
  159. cal $_catch
  160. end 0