|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 8448 (0x2100)
Types: TextFile
Names: »lookbstext«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦this⟧ »lookbstext«
(lookbs=slang fpnames list.no xref.no type.yes insertproc entry.no
lookbs
head 1
)
; integer procedure lookbs
; The bs-claims for a given bs-document are copied from an internal
; process description to an integer array.
;
; call: lookbs(proc,doc,bs-claims)
; lookbs (return value, integer). The result of monitorprocedure
; 118: lookup bs-claims,
; 0 means claims looked up,
; 2,3,6 means claims not looked up.
; proc (call value, string or array of any type).
; Contain the name of the internal process.
; doc (call value, string or array of any type).
; Contain the name of the bs-document.
; bs-claims (return value,integer array, length>=4*max key).
; 1th element entry claim, key 0
; 2th element segment claim, key 0
; . . .
; (2*max key)th element entry claim, max key
; (2*max key+1)th element segment claim, max key
;
; If proc or doc are arrays the length of theese must at least be
; 4 integer words.
\f
b. g1,f5 ; begin block for insertproc
w.
k=0 ;
s. ; begin codeprocedure
b. a25,j55,g2,e7 ; begin 1. segment
a9=(:3+1:)<2 -3 ; a9:=(max perm key)*4-2
h. ;
g0=0 ;
f5: ;
g1: g2,g2 ; headword
j3: g0+3 ,0 ; reserve
j4: g0+ 4,0 ; take ekspression
j6: g0+ 6,0 ; end register ekspression
j13:g0+13,0 ; last used
j16:g0+16,0 ; segment table base
j21:g0+21,0 ; generel alarm
j29:g0+29,0 ; param alarm
j30:g0+30,0 ; saved stack ref
g2=k-2-g1 ;
w. ;
f0: g0 ; start of ext. list
0 ;
02 01 80,00 00 00; date
f1: rl. w2 (j13.) ; w2:= last used
ds. w3 (j30.) ; save stack ref, save w3
al w1 -20 ; reserve
jl. w3 (j3.) ; 12 byte
ld w1 -100 ;
rs w1 x2-12 ;
ds w1 x2-14 ;
ds w1 x2-4 ;
dl w1 x2+8 ; 1. param
al w3 2.11111 ;
la w3 0 ; get kind
se w3 24 ; if short string or
sn w3 28 ; long then
jl. a1. ; goto a1
se w3 4 ; if long procedure or
sn w3 12 ; long expression then
jl. a0. ; then goto a0.
sn w3 8 ; if string expression then
jl. a0. ; goto a0.
sl w3 17 ; if not array
sl w3 23 ; then
jl. (j29.) ; param alarm
ba w1 0 ; abs. dope addr
rl w3 x1 ; w3:=lower index value-K
al w3 x3+1 ; w3:=lower index value
rl w0 x1-2 ; w0:=upper index
ws w0 6 ; array length
sh w0 6 ; if less then 8 byte then
jl. e1. ; error
wa w3 (x2+8 ) ; w3:=w3+array base
dl w1 x3+2 ; else
ds w1 x2-18 ; move string
dl w1 x3+6 ;
ds w1 x2-14 ;
jl. a7. ; next param
a0: dl w1 x2+8 ;
so w0 16 ; if expression then
jl. w3 (j4.) ; take expression
ds. w3 (j30.) ;
al w3 a8 ; change the jump at a4 to
hs. w3 a4. ; jl. a0.
a1: dl w0 x1 ; get string or string type
sl w0 0 ; if short string then
jl. a3. ; goto a3
hs. w3 a2. ; else store rel. addr. in segm.
bz w3 6 ; segment number
ls w3 1 ; *2
wa. w3 (j16.) ; +segm. table base
rl w3 x3 ; get segment addr.
rl w0 x3 ; load segment (if out)
h. al w1 x3 ;
a2: +0 ; w1:=addr. of string
w. al w3 a6 ; change the jump at a4 to
hs. w3 a4. ; jl. a1.
dl w0 x1 ; get string
am -8 ;
a3: al w1 x1+4 ;
rx w1 x2-12 ; (x2-12)=0 or 4
am x1 ;
ds w0 x2-18 ; store string
sz w0 127 ; if no more chars or
se w1 0 ; w1=4 then
jl. a5. ; goto a5
al w1 4 ;
rx w1 x2-12 ;
h. jl. ; jl. to a1 or to a0
a4: a1.+1 ;
w. a6=a1-a4+1, a8=a0-a4+1
a5: al w3 a6 ; change the jump at a4 to
hs. w3 a4. ; jl. a1.
;; next param
a7: al w1 0 ;
rs w1 x2-12 ;
dl w1 x2+12 ; 1. param
al w3 2.11111 ;
la w3 0 ; get kind
se w3 24 ; if short string or
sn w3 28 ; long then
jl. a11. ; goto a11
se w3 4 ; if long procedure or
sn w3 12 ; long expression then
jl. a10. ; then goto a10.
sn w3 8 ; if string expression then
jl. a10. ; goto a10.
sl w3 17 ; if not array
sl w3 23 ; then
jl. (j29.) ; goto e3
ba w1 0 ; abs. dope addr
rl w3 x1 ; w3:=lower index value-K
al w3 x3+1 ; w3:=lower index value
rl w0 x1-2 ; w0:=upper index
ws w0 6 ; array length
sh w0 6 ; if less then 8 byte then
jl. e1. ; error
wa w3 (x2+12) ; w3:=w3+array base
dl w1 x3+2 ; else
ds w1 x2-8 ; move string
dl w1 x3+6 ;
ds w1 x2-4 ;
jl. a17. ; next param
a10:dl w1 x2+12 ;
so w0 16 ; if expression then
jl. w3 (j4.) ; take expression
ds. w3 (j30.) ;
al w3 a18 ; change the jump at a14 to
hs. w3 a14. ; jl. a10.
a11:dl w0 x1 ; get string or string type
sl w0 0 ; if short string then
jl. a13. ; goto a13
hs. w3 a12. ; else store rel. addr. in segm.
bz w3 6 ; segment number
ls w3 1 ; *2
wa. w3 (j16.) ; +segm. table base
rl w3 x3 ; get segment addr.
rl w0 x3 ; load segment (if out)
h. al w1 x3 ;
a12:+0 ; w1:=addr. of string
w. al w3 a16 ; change the jump at a14 to
hs. w3 a14. ; jl. a11.
dl w0 x1 ; get string
am -8 ;
a13:al w1 x1+4 ;
rx w1 x2-12 ; (x2-12)=0 or 4
am x1 ;
ds w0 x2-8 ; store string
sz w0 127 ; if no more chars or
se w1 0 ; w1=4 then
jl. a15. ; goto a15
al w1 4 ;
rx w1 x2-12 ;
h. jl. ; jl. to a11 or to a10
a14:a11.+1 ;
w. a16=a11-a14+1, a18=a10-a14+1
a15:al w3 a16 ; change the jump at a14 to
hs. w3 a14. ; jl. a11.
;; next param
a17:bz w1 x2+15 ; get kind of next param
se w1 18 ; if kind<> integer array then
jl. w3 (j29.) ; error
dl w1 x2+16 ; else get param
ba w1 0 ; w1:=abs dope address
rl w3 x1 ; w3:=lower index-K (K=2)
al w3 x3+2 ; w3:=address of first element
rl w0 x1-2 ; w0:= upper index
ws w0 6 ; w0:0array length
sh w0 a9 ; if array length<max perm key*4+4 then
jl. e1. ; error else
wa w3 (x2+16) ; w3:=w3+array base
al w1 x3 ; w1:=array address
al w3 x2-20 ; w3:=process name address
al w2 x2-10 ; w2:=device name address
jd 1<11+118 ; lookup bs claim(array,device,process);
al w2 x2+10 ;
rs. w2 (j13.) ; set last used to old stack top
al w1 (0) ; w1:=result
jl. (j6.) ; return register ekspression
e1: al w1 (0) ; error
al w1 x1+1 ;
al. w0 f3. ;
jl. w3 (j21.) ; generel alarm
f3:<:<10>length :>
h. ;
0,r.(:504-k:) ; fill
w. ;
<:<10>lookbs <0>:>;
e. ; end 1. segment
e.
w.
g1:
g0: 1 ; 1 segment
0,0,0,0 ; fill
1<23+f1 ;
3<18+25<12+41<6+41 ; integer procedure(no type,no type,integer array);
0
4<12 +f0 ;
1<12 +0 ;
n.
▶EOF◀