|
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: 6912 (0x1b00)
Types: TextFile
Names: »tlookaux«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦2cfec6318⟧ »incsys«
└─⟦this⟧
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦this⟧ »tlookaux«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦70d387dbb⟧ »incsys«
└─⟦this⟧
(lookupaux=set 1
(lookupaux=slang fpnames type.yes insertproc entry.no
lookupaux )
if ok.no
end
)
;hcø 19 6 72
;b. ;fpnames dummy block
b. g1, e20 w. ;block with names for tails and insertproc
k=10000
s. g6,j46,f7,b15,i10,d3;start of slang segment for procedures
h.
g0=0 ;g0:=no of externals
e20:
g1: g2 , g2 ;head word: rel of last point, rel of last abs word
j13: g0 + 13 , 0 ;RS entry 13, last used
j30: g0 + 30 , 0 ;RS entry 30, saved stack ref, saved w3
j3: g0 + 3 , 0 ;RS entry 3, reserve
j4: g0 + 4 , 0 ;RS entry 4, take expression
j6: g0 + 6 , 0 ;RS entry 6, end register expression
j12: g0 + 12 , 0 ;RS entry 12, UV
j16: g0 + 16 , 0 ;RS entry 16, segment table base
j29: g0 + 29 , 0 ;RS entry 29, param alarm
g2 = k-2-g1 ;end of abs words:=end of points
w.
e0: g0 ;start external list
0
80 01 28,14 00 00
b0: rl w1 0 ; result:=result monitor proc
jl. (j6.) ; end register expression
b1: rs. w1 b2. ; save link
dl w1 x3+2 ; move name to reserved locations
ds w1 x2+2 ;
dl w1 x3+6 ;
ds w1 x2+6 ;
jl. (b2.) ; return
b2: 0
w.
e1: ;entry lookup_aux
rl. w2 (j13.) ;w2:=last used
ds. w3 (j30.) ;saved stack ref, saved w3
dl w1 x2+16 ; take param tail
ba w1 0 ; w1:=abs dope
rl w3 x1 ; w3:=lower index - 2
wa w3 (x2+16) ;
al w1 x3+2 ; w3:=addr first elem
rs w1 x2+14 ;
al w1 -8 ; reserve 8 bytes in stack
jl. w3 (j3.) ;
ds. w2 (j30.) ; save stack ref, save w3
dl w1 x2+12 ;take param docname
al w2 x2-8 ;
so w0 16 ;if expression then
jl. w3 (j4.) ;take expression
ds. w3 (j30.) ;save stack ref,save w3
al w2 x2+12 ;
jl. w3 d1. ;take param name
al w2 x2-18 ;
jl. w1 b1. ; move docname
dl w1 x2+16 ; take param 1 name
so w0 16 ; if expression then
jl. w3 (j4.) ; take expression
ds. w3 (j30.) ; save stack ref, save w3
al w2 x2+8 ;
jl. w3 d1. ; w3:=takestring
al w2 x2-6 ; release reserved locations
rs. w2 (j13.) ;
rl w1 x2+14 ; w1:=tail
al w2 x2-8 ; w2:=doc
jd 1<11+86 ; lookup auxillary entry
jl. b0. ;end register expression
; takestring
; Anders Lindgård
; 1978-10-27
; procedure take string;
; registers at entry at return
; w0 not used destroyed
; w1 abs addr of string/elem destroyed
; w2 addr of first formal unchanged
; w3 link addr of start of name
; procedure take string1;
; registers at entry at return
; w0 not used destroyed
; w1 abs address of elem destroyed
; w2 last used last used+6
; w3 link addr of start of name
b. a8,c6,b24 ; begin
w.
c0: 0, c1: 0 ; first formal,link
c2: 0,r.5 ; name
c3: 0 ; work
c4: 0 ; work
d1: al w2 x2+6 ;entry take string1
d0: ;entry take string
ds. w3 c1. ;save link , save w2
rl w0 x2+0 ;w0:=first formal
al w3 2.11111 ;
la w3 0 ;w3:=kind+()
se w3 10 ;if integer expression
sn w3 26 ;or integer then
jl. a8. ;goto proc addr
se w3 24 ;if -,string variable or
sn w3 8 ;-,string expression
jl. a1. ;begin comment array;
sh w3 22 ;if variable or
sh w3 15 ;procedure or expression then
jl. w3 (j29.) ;param alarm
ba w1 0 ;w1:=abs dope addr
rl w3 x1 ;
wa w3 (x2+2) ;w3:=first addr-2
bz w0 x2+1 ;w0 :=kind
al w3 x3+0 ;
sh w0 17 ;if kind = l7 then boolean array
jl. (c1.) ;
al w3 x3 +1 ;
sh w0 18 ;if kind = 18 then integer array
jl. (c1.) ;
al w3 x3+0 ;
sh w0 20 ;if kind = 20 then real array
jl. (c1.) ;
al w3 x3+4 ;
jl. (c1.) ;
a8: ;proc addr:
al. w3 c2. ;w3:=name addr
rl w2 x1 ;w2:=name address
dl w1 x2+4 ;w1w0:=first part name
ds w1 x3+2 ;
dl w1 x2+8 ;w1w0:=last part name
ds w1 x3+6 ;
rs w2 x3+8 ;store name addr as name table entry
rl. w2 c0. ;w2:=stack ref
jl. (c1.) ;end;
a1:
dl w1 x1 ;w1w0:=string value
sh w0 0 ;if layout then
jl. w3 (j29.) ;param alarm
sh w1 -1 ;if long string then
jl. a3. ;goto long string
al. w3 c2. ;w3:=name addr
ds w1 x3+2 ;store string value
ld w1 -65 ;w1w0:=0;
ds w1 x3+6 ;last part name:=0;
jl. (c1.) ;end get string
a3: ;long string:
ds. w1 c4. ;store item
ld w1 -65 ;w1w0:=0
ds. w1 c2.+6 ;name(3):=name(4):=0;
rl. w0 c1. ;w0:=return addr
al. w3 a7. ;w3:=exit addr
ws w0 6 ;w0:=rel return adr
rs. w0 (j12.) ;save rel return in UV
dl. w1 c4. ;w1w0:=item
a4: ;find first part:
bz w3 0 ;w3:=rel segm no
ls w3 1 ;w3:=w3*2
wa. w3 (j16.) ;w3:=segment addr
rl w3 x3 ;w3:=first addr(segment);
bz w0 1 ;w0:=rel
wa w3 0 ;w3:=segment+rel
dl w1 x3 ;w1:=item (ref out of this segment)
sh w1 -1 ;if long string then goto long string
jl. a4. ;goto long string
ds w1 x2+2 ;save first part
al w3 x3-4 ;x3:=addr next
a5: dl w1 x3 ;take next: (ref out of this segment?)
sh w1 -1 ;if long string then
jl. a6. ;goto next long
al. w3 c2. ;w3:=name addr
ds w1 x3+6 ;name 3,4:=second part
dl w1 x2+2 ;w1w0:=first part
ds w1 x3+2 ;name 1,2:=first part
rl. w1 (j12.) ;w1:=rel return addr
a7: jl. x1+0 ;return
a6: ;long string second item
bz w3 0 ;w3:=rel segm no
ls w3 1 ;w3:=w3*2
wa. w3 (j16.) ;w3:=segment
rl w3 x3 ;w3:=first addr(segment);
bz w0 1 ;w0:=rel
wa w3 0 ;w3:=addr second item
jl. a5. ;goto take second
e.
m. end code of this segment
h. 0,r.(:10504-k:) w.
<:lookupaux <0>:>
e. ;end slang segment
; lookup_aux
g1:
g0: 1 ;first tail: area with 1 segment
0,0,0,0 ;fill
1<23+e1-e20 ;entry point read_dev
3<18+25<12+41<6+41,0;integer procedure(undef,undef,integer array);
4<12+e0-e20 ;code proc start of external
1<12 ;1 code segment
n.
▶EOF◀