169 lines
3.2 KiB
Text
169 lines
3.2 KiB
Text
#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
|
|
|