|
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: 4608 (0x1200)
Types: TextFile
Names: »takestring«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦545a06c52⟧ »tcodeproc«
└─⟦this⟧
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »takestring«
└─⟦this⟧ »tcodeproc/takestring«
; 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.
▶EOF◀