|
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: »base4tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »base4tx «
; fgs 1982.12.17 base page ...1...
b. c2,g3 ; block for insertproc
w.
d.
p.<:fpnames:>
l.
s. b24 ; block for base
w.
k=h55 ;
; procedure write_pair;
;
; the procedure writes the pair addressed by w1 on current output
;
; call : return :
;
; w0 : - destroyed
; w1 : addr destroyed
; w2 : - unchanged
; w3 : link destroyed
;
b. a0, b1
w.
b24: rs. w3 a0. ; save link;
dl w1 x1 ; entry write_pair:
ds. w1 b1. ; get pair;
rl. w0 b0. ; write lower;
jl. w3 h32.-2 ;
1<23+32<12+10 ;
rl. w0 b1. ; write upper;
jl. w3 h32.-2 ;
1<23+32<12+10 ;
jl. (a0.) ; return;
a0: 0 ; saved link
b0: 0 ; lower of pair:
b1: 0 ; upper of pair:
e. ; end write pair;
\f
; fgs 1985.03.14 base page ...2...
;
; the procedure writes the bases of the process on current output
;
; call: return:
;
; w0 : unused unchanged
; w1 : link -
; w2 : unused -
; w3 : - -
;
b. a4, c3
w.
b23: ds. w1 c1. ; entry write bases:
ds. w3 c3. ; save registers;
rl. w2 h16. ; w2 := current process;
al. w0 a0. ; catalog base:
jl. w3 h31.-2 ; write (<:catbase:>);
al w1 x2+70 ; addr of cat base;
jl. w3 b24. ; write pair;
al. w0 a1. ; standard base:
jl. w3 h31.-2 ; write (<:std base:>);
al w1 x2+78 ; addr of std base;
jl. w3 b24. ; write pair;
al. w0 a2. ; user base:
jl. w3 h31.-2 ; write (<:user base:>);
al. w1 h58. ; get user base;
jl. w3 b24. ; write pair;
al. w0 a3. ; max base:
jl. w3 h31.-2 ; write (<:max base:>);
al w1 x2+74 ; get max base;
jl. w3 b24. ; write pair;
al. w0 a4. ;
jl. w3 h31.-2 ; write (<:<10><10>:>);
dl. w1 c1. ; restore
dl. w3 c3. ; registers;
jl x1 ; return;
a0: <:<10>cat base : :>
a1: <:<10>std base (login ): :>
a2: <:<10>user base : :>
a3: <:<10>max base (project): :>
a4: <:<10><10>:>
c0: 0 ; saved registers;
c1: 0 ;
c2: 0 ;
c3: 0 ;
e. ; end write bases;
\f
;fgs 1985.03.14 base page ...3...
c0=k-h55 ; entry base:
b. a9, e1 ;block for base
w.
al w2 0 ;intaddr:=addr(cat base)-70
a9: ba w3 x3+1 ;if first param<>text then goto test integer
rl w1 x3 ;
se.w1(b4.) ;
jl. a0. ;
dl.w1 b22. ;text:=<:what:>;
sn w0(x3+2) ;if text <>
se w1(x3+4) ; param then
jl. a1. ;goto next text
jl.w1 b23. ;write bases;
jl. a9. ;goto first again
a2: sn w0(x3+2) ;test text: if text<>param then goto next text
se w1(x3+4) ;
jl. a1. ;
dl w1 x3+8 ;
sn w0 0 ;
se w1 0 ;
jl. a1. ;
ba w3 x3+1 ;w3:=addr of next param
sn w2 16 ;if text=<:abs:> then
al.w2 b14. ;intaddr:=addr(absint)-70
sn w2 12 ;if text=<:user:> then
al.w2 b13. ;intaddr:=addr(user base)-70
sh w2 8 ;if text=<:max:> or <:std:> then
a0: am. (h16.) ;test integer: modif w2 by proc descr addr
dl w1 x2+70 ;w01:=interval
al.w2 b16. ;index:=0
ds w1 x2 ;b16:=interval
rs w0 x2+2 ;b17:=intervalstart
jl. 4 ;
a5: ba w3 x3+1 ;next param:
rl w1 x3 ;
se.w1(b10.) ;if param<>integer then
jl. a7. ;goto test what
dl w1 x3+4 ;w0:=param
se.w1(b15.) ;if next param= .integer then
jl. a4. ;begin
al w3 x3+4 ; next param
hs w0 0 ; w0:=w0<12+param
hl w0 x3+3 ;end
a4: wa.w0 b17. ;b16(index):=intervalstart+w0
rs w0 x2 ;
rs w0 x2-2 ;
al w2 x2+2 ;index:=index+1
sh.w2 b17. ;if index<2 then goto next param
jl. a5. ;
ba w3 x3+1 ;next param
rl w1 x3 ;
\f
; rc 1981.08.31 base page ...4...
a7: se.w1(b4.) ;test what:
jl. a3. ;if not text then goto test end
dl.w1 b22. ;text:=<:what:>
sn w0(x3+2) ;if text <>
se w1(x3+4) ; param then
jl. e0. ;goto param error
al w2 0 ;param=what:=true
ba w3 x3+1 ;w3:=addr of next param
rl w1 x3 ;w1:=next param
a3: sl.w1(b10.) ;test end: if param<>end then
jl. e0. ;goto parameter error
dl.w1 b16. ;set base
al.w3 b11. ;
jd 1<11+72 ;
se w0 0 ;if base not set then
jl. e1. ;goto interval error
sn w2 0 ;if last param = <:what:> then
jl.w1 b23. ;write bases
jl. a6. ;goto return to fp
e1: am b18 ;interval error
e0: al.w0 b19. ;parameter error
jl.w3 h31.-2 ;
am 1 ;
a6: al w2 0 ;
jl.w3 h7. ;return to fp
a1: al w2 x2+4 ;next text:
sl w2 20 ;if not found then
jl. e0. ;goto param error
dl.w1 x2+b12. ;get next text
jl. a2. ;goto test text
i.
e. ; end block for base
\f
; rc 1981.08.31 base page ...5...
b10: 4<12+4 ;intparam
b15: 8<12+4 ;.intparam
b4 : 4<12+10 ;textparam
b21: <:<10>:>
b19: <:<10>***base param<10><0>:>
b18=k-b19,<:<10>***base interval<10><0>:>
;variables for base
b11: 0,-1 ;absint ;nul
b14=b11-68 ;addr (absint)-68
b13=h58-70 ;addr (user base)-70
0 ;interval ;max
b16:b0: 0 ;
b17:b3: 0 ;intervalstart ;work in use
b12=k-2
<:max:>, 0 ;b12+4
<:std:>, 0 ;b12+8
<:user<0><0>:> ;b12+12
<:abs:>, 0 ;b12+16
b22=k+2
<:what<0><0>:> ;b22
e. ;end segment base
c2=k-h55 ;length of program
\f
; rc 1981.08.31 base page ...6...
; base
g0:
g1: (:c2+511:)>9 ; segm
0, r.4
s2 ; date
0,0 ; file, block
2<12+c0 ; contents, entry
c2 ; length
m. rc base 1985.03.14
d.
p.<:insertproc:>
l.
e.
▶EOF◀