199 lines
4.9 KiB
Plaintext
199 lines
4.9 KiB
Plaintext
|
#include "e.h"
|
||
|
|
exp $GETLINEN
|
||
|
|
exp $ME
|
||
|
|
exp $STATIC
|
||
|
|
exp $DYNAMIC
|
||
|
|
exp $ARGBASE
|
||
|
|
exp $SETMYSTA
|
||
|
|
exp $SETNSTAT
|
||
|
|
exp $ISA68
|
||
|
|
exp $ISPUT
|
||
|
|
exp $ISGET
|
||
|
|
exp $GETCALLE
|
||
|
|
|
||
|
|
; function getlineno :integer;
|
||
|
|
pro $GETLINEN,0 ; return line no from hol0
|
||
|
|
loe 0
|
||
|
|
ret SZWORD
|
||
|
|
end
|
||
|
|
|
||
|
|
pro $ME,0
|
||
|
|
lor 0 ; lb -> stack
|
||
|
|
dch ; caller's lb -> stack
|
||
|
|
ret SZADDR ; clb -> function result area
|
||
|
|
end 0
|
||
|
|
|
||
|
|
pro $STATIC,0
|
||
|
|
LFL SZADDR ; param (lb of caller) (after static link)
|
||
|
|
lpb ; ab of param
|
||
|
|
loi SZADDR ; static link of param
|
||
|
|
ret SZADDR
|
||
|
|
end 0
|
||
|
|
|
||
|
|
pro $DYNAMIC,0
|
||
|
|
LFL SZADDR ; param (lb of caller) (after static link)
|
||
|
|
dch ; follow dynamic chain, using lb of caller
|
||
|
|
ret SZADDR
|
||
|
|
end 0
|
||
|
|
|
||
|
|
pro $ARGBASE,0
|
||
|
|
LFL SZADDR ; param (somebody's lb)
|
||
|
|
lpb ; convert to somebody's ab
|
||
|
|
ret SZADDR
|
||
|
|
end 0
|
||
|
|
|
||
|
|
pro $SETMYSTA,0
|
||
|
|
LFL SZADDR ; place param on stack
|
||
|
|
lor 0 ; lb -> stack , for dch
|
||
|
|
dch ; caller's lb -> stack
|
||
|
|
lpb ; caller's ab
|
||
|
|
sti SZADDR ; store param in caller's static link
|
||
|
|
ret 0
|
||
|
|
end 0
|
||
|
|
|
||
|
|
#ifndef VAX4
|
||
|
|
pro $SETNSTAT,0 ; called from RNSTART of insert n extra levels in
|
||
|
|
; the static chain of A68 (i.e. RNSTART's caller);
|
||
|
|
; there is guaranteed to be enough vacant space at
|
||
|
|
; the top of the IB of A68
|
||
|
|
lor 0 ; my LB
|
||
|
|
dch ; RNSTART LB
|
||
|
|
adp SZADDR ; fictitious LB
|
||
|
|
; BUT THIS MAY NOT BE LEGAL EM. REVIEW WHEN
|
||
|
|
; RNSTART IS REWRITTEN.
|
||
|
|
dup SZADDR
|
||
|
|
lxa 2 ; A68 AB
|
||
|
|
loi SZADDR ; A68 static
|
||
|
|
exg SZADDR
|
||
|
|
lpb ; fictitious AB
|
||
|
|
sti SZADDR ; (fictitious AB) := A68 static
|
||
|
|
dup SZADDR
|
||
|
|
lxa 2 ; A68 AB
|
||
|
|
sti SZADDR ; (A68 AB) := fictitious LB
|
||
|
|
2
|
||
|
|
lol SZADDR ; n
|
||
|
|
loc 1
|
||
|
|
sbi SZWORD
|
||
|
|
dup SZWORD
|
||
|
|
stl SZADDR ; n := n-1
|
||
|
|
zeq *3
|
||
|
|
dup SZADDR
|
||
|
|
lpb ; fictitious AB
|
||
|
|
dup SZADDR
|
||
|
|
loi SZADDR
|
||
|
|
exg SZADDR
|
||
|
|
SFF SZADDR ; (fictitious AB + 1) := (fictitious AB)
|
||
|
|
adp SZADDR ; new fictitious LB
|
||
|
|
dup SZADDR
|
||
|
|
dup SZADDR
|
||
|
|
lpb ; new fictitious AB
|
||
|
|
SFF -SZADDR ; (new fictitious AB -l = old fictitious AB) :=
|
||
|
|
; new fictitious LB
|
||
|
|
bra *2 ; with the new fictitious LB on the stack
|
||
|
|
3
|
||
|
|
ret 0
|
||
|
|
end 0
|
||
|
|
#else
|
||
|
|
pro $SETNSTAT,SZWORD ; called from RNSTART of insert n extra levels in
|
||
|
|
; the static chain of A68 (i.e. RNSTART's caller);
|
||
|
|
; this version does not assume that the space between
|
||
|
|
; LB and AB is a constant. It calls itself recursively
|
||
|
|
; to create n activation records, whose static chains
|
||
|
|
; are linked as required. The last activation then
|
||
|
|
; copies the return status block of RNSTART over itself,
|
||
|
|
; so exiting from RNSTART but leaving the extra chains
|
||
|
|
; still within the stack.
|
||
|
|
lor 0 ; SLB
|
||
|
|
dch ; RLB
|
||
|
|
dup SZADDR ; RLB | RLB
|
||
|
|
dch ; RLB | ALB
|
||
|
|
lpb ; RLB | AAB
|
||
|
|
dup SZADDR ; RLB | AAB | AAB
|
||
|
|
loi SZADDR ; RLB | AAB | (AAB)
|
||
|
|
lor 0 ; RLB | AAB | (AAB) | SLB
|
||
|
|
dch ; RLB | AAB | (AAB) | RLB
|
||
|
|
lpb ; RLB | AAB | (AAB) | RAB
|
||
|
|
sti SZADDR ; RLB | AAB (RAB) := (AAB)
|
||
|
|
sti SZADDR ; (AAB) := RLB
|
||
|
|
; now my caller (RNSTART the first time) has been linked
|
||
|
|
; into the static chain of HIS caller.
|
||
|
|
lol SZADDR ; n
|
||
|
|
loc 1
|
||
|
|
sbi SZWORD ; n-1
|
||
|
|
dup SZWORD
|
||
|
|
zeq *4
|
||
|
|
lxl 1
|
||
|
|
cal $SETNSTAT
|
||
|
|
asp SZWORD+SZADDR ; but it should never return here
|
||
|
|
nop
|
||
|
|
4 ; now we must move the return status block of RNSTART
|
||
|
|
; on top of our own. We are still statically within RNSTART
|
||
|
|
LFL 0 ; RLB
|
||
|
|
dup SZADDR ; RLB | RLB
|
||
|
|
lpb ; RLB | RAB
|
||
|
|
exg SZADDR ; RAB | RLB
|
||
|
|
sbs SZWORD ; Amount to be moved
|
||
|
|
dup SZWORD ; A | A
|
||
|
|
stl -SZWORD ; A
|
||
|
|
lor 0 ; A | SLB
|
||
|
|
dup SZADDR ; A | SLB | SLB
|
||
|
|
lpb ; A | SLB | SAB
|
||
|
|
exg SZADDR ; A | SAB | SLB
|
||
|
|
sbs SZWORD ; A | SA (the size of our own return status block)
|
||
|
|
exg SZWORD ; SA | A
|
||
|
|
sbi SZWORD ; SA-A
|
||
|
|
lor 0 ; SLB
|
||
|
|
ads SZWORD ; new SLB to be
|
||
|
|
str 1 ; set SP there
|
||
|
|
lor 1 ; TO (=SP the destination of the move)
|
||
|
|
dup SZADDR ; TO | TO
|
||
|
|
LFL 0 ; TO | TO | RLB (the source of the move)
|
||
|
|
exg SZADDR ; TO | RLB | TO
|
||
|
|
lol -SZWORD ; TO | RLB | TO | A
|
||
|
|
bls SZWORD ; TO
|
||
|
|
str 0 ; set SLB to the moved copy of RNSTART's block
|
||
|
|
ret 0 ; return to RNSTART's caller, resetting his registers
|
||
|
|
end SZWORD ; one local to store A
|
||
|
|
#endif
|
||
|
|
|
||
|
|
pro $GETCALLE,0 ; returns LB of nearest A68 frame on stack, A68 caller
|
||
|
|
LFL SZADDR ; param (lb of callee, routine) (after static link)
|
||
|
|
1
|
||
|
|
dch ; follow dynamic chain
|
||
|
|
dup SZADDR ; duplicate either to return or follow next time
|
||
|
|
lof -SZWORD ; lb - SZWORD is addres of frame stamp
|
||
|
|
loc A68STAMP
|
||
|
|
bne *1 ; do again if not A68 frame
|
||
|
|
ret SZADDR ; return lb of frame
|
||
|
|
end 0
|
||
|
|
|
||
|
|
pro $ISA68,0
|
||
|
|
LFL SZADDR ; get param, lb of frame to test
|
||
|
|
adp -SZWORD
|
||
|
|
loi SZWORD ; load frame stamp
|
||
|
|
loc A68STAMP
|
||
|
|
cmi SZWORD ; compare it with 'a68stamp'
|
||
|
|
teq ; is it the same
|
||
|
|
ret SZWORD ; return answer, true=1 false=0
|
||
|
|
end 0
|
||
|
|
|
||
|
|
pro $ISPUT,0
|
||
|
|
LFL SZADDR ; get param, lb of frame to test
|
||
|
|
adp -SZWORD
|
||
|
|
loi SZWORD ; load frame stamp
|
||
|
|
loc PUTSTAMP
|
||
|
|
cmi SZWORD ; compare it with 'putstamp'
|
||
|
|
teq
|
||
|
|
ret SZWORD ; return answer, true=1 false=0
|
||
|
|
end 0
|
||
|
|
|
||
|
|
pro $ISGET,0
|
||
|
|
LFL SZADDR ; get param, lb of frame to test
|
||
|
|
adp -SZWORD
|
||
|
|
loi SZWORD ; load frame stamp
|
||
|
|
loc GETSTAMP
|
||
|
|
cmi SZWORD ; compare it with 'getstamp'
|
||
|
|
teq
|
||
|
|
ret SZWORD ; return answer, true=1 false=0
|
||
|
|
end 0
|