123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169 |
- #include "e.h"
- exa .HTOP ; the label holtop
- exa .1 ; the Pascal global area
- exa _extfl ; the routine '_ini' puts 'input' & 'output' here
- exp $ESTART0
- exp $ESTART_
- exp $ESTOP_
- exp $ABORT
- ; PROCEDURE ESTART0
- pro $ESTART0,0
- lor 0 ; my LB
- dup SZADDR
- dch ; _m_a_i_n's LB
- dup SZADDR
- str 0 ; pretend I am in _m_a_i_n
- lae .HTOP-FIRSTIBOFFSET; destination address (holtop-firstiboffset)
- ; now calc how much to move
- lal 0
- lor 0
- sbs SZWORD ; subtract address of param from lb to get link space
- loc SZWORD+SZADDR+SZADDR
- ads SZWORD ; allow for one parameter of _m_a_i_n
- bls SZWORD ; block move
- ; now the global area contains an exact copy of
- ; _m_a_i_n's stack frame, and main will subsequently
- ; adjust its LB to point to this global copy, thus
- ; making it a part of the official stack.
- str 0 ; get my LB back
- ret 0
- end 0
- ; PROCEDURE ESTART_ (INPUT,OUTPUT);
- pro $ESTART_,0
- .2
- con 2,0,0 ; array that is to be _extfl
- .3
- con 0I SZADDR ; PASCAL trap routine
- .4
- con 0 ; trapn
- con 0 ; signaln
- LFL SZADDR+SZADDR ; base address for input (2nd param)
- lae .1
- sbs SZWORD ; subtract address from hol1 to get offset
- ste .2+SZWORD ; store in array of offsets
- LFL SZADDR ; and again for output (1st param after static link)
- lae .1
- sbs SZWORD
- ste .2+SZWORD+SZWORD ; store in array
- lxl 2 ; params for _ini
- lae .2
- lae .1
- lxa 2
- cal $_ini
- asp SZADDR+SZADDR+SZADDR+SZADDR
- loc A68STAMP ; _m_a_i_n's frame stamp, for isa68, any positive number
- ste .HTOP-FSTAMPOFFSET ; it is in a SZWORD integer, 1st local var
- inp $_usigs
- cal $_usigs ; catch UNIX interrupts as EM trap 15
- inp $_acatch
- lpi $_acatch ; A68 trap routine
- sig
- lae .3
- sti SZWORD ; preserve PASCAL trap routine
- zre .4 ; trapn
- ret 0
- end 0
- ; procedure usigs;
- ; var i: integer;
- ; begin
- ; for i := 1 to 16 do signal(i, ucatch);
- ; end;
- pro $_usigs,SZWORD
- mes 9,0
- loc 1
- loc 16
- bgt *2
- loc 1
- stl -SZWORD
- 1
- zer SZWORD
- inp $_ucatch
- lpi $_ucatch
- lol -SZWORD
- cal $signal
- asp SZWORD+SZWORD+SZWORD
- lol -SZWORD
- loc 16
- beq *2
- lol -SZWORD
- inc
- stl -SZWORD
- bra *1
- 2
- mes 3,-SZWORD,4,1
- ret 0
- end SZWORD
- ; procedure ucatch(signo: integer);
- ; begin
- ; trap(15);
- ; end;
- pro $_ucatch,0
- mes 9,4
- lol 0
- ste .4+SZWORD ; signaln
- #ifdef BSD4
- loc 0
- cal $sigsetmask ; unblock all signals
- asp SZWORD
- LLC 0 ; SIG_DFL
- lol 0
- cal $signal ; because 4.2 Inices do not reset caught signals
- asp SZADDR+SZWORD
- #endif
- loc 15
- cal $trap
- asp SZWORD
- mes 3,0,4,0
- ret 0
- end 0
- pro $_acatch,SZWORD
- loc PASCALSTAMP
- stl -SZWORD
- lol 0 ; EM trap number
- dup SZWORD
- ste .4 ; trapn
- ngi SZWORD
- lxl 0
- cal $ERRORR ; should never return
- end SZWORD
- pro $ESTOP_,0
- loc 0
- cal $_hlt
- end 0
- pro $ABORT,0
- loe .4 ; trapn
- zne *1
- loc 1 ; if abort is called then presumably some error has
- ; occured, thus exit code 1
- cal $_hlt
- 1
- loe .4 ; trapn
- loc 15
- bne *2 ; if not a UNIX signal
- cal $_cleanup
- loe .4+SZWORD ; signaln
- cal $getpid
- lfr SZWORD
- cal $kill
- 2
- lae .3 ; PASCAL trap routine
- loi SZWORD
- dup SZWORD
- zeq *3 ; no PASCAL trap routine
- sig
- asp SZWORD
- loe .4
- trp ; now let PASCAL handle the same trap
- 3
- loe .4 ; trapn
- cal $_catch
- end 0
|