|
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: 6144 (0x1800)
Types: TextFile
Names: »testabswtx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »testabswtx «
(testabsw=slang
testabsw)
b. g1, f6 w. ; for insertproc
d.
p.<:fpnames:>
l.
s. a7, b99, g99 ; begin segment:
w. ;
k = h55 ;
b4 , 0 ; length of program , empty word;
jl. a0. ; goto start;
;procedure outbits (value);
; w0 integer value unchanged
; w1 - -
; w2 - -
; w3 link -
b. a0, b9, c9 ;
w.
a1: ds. w0 b0. ; save registers;
ds. w2 b2. ;
rl. w1 b0. ; value := saved w0;
al w2 24 ; count := 24;
a0: sl w1 0 ; if value.msb = 1 then
am -1 ; bit := 1 else
al w0 1 ; bit := 0;
rs. w1 c1. ; save value;
jl. w3 h32.-2 ; outinteger (out, bit);
32<12+1 ; layout= d;
rl. w1 c1. ; restore value;
ls w1 1 ; (value, count) := (value, count) shift 1;
al w2 x2-1 ; count := count - 1;
se w2 0 ; if count <> 0 then
jl. a0. ; goto rep;
dl. w0 b0. ; restore registers;
dl. w2 b2. ;
jl x3 ; return;
0 ; saved w3;
b0: 0 ; - w0;
0 ; - w1;
b2: 0 ; - w2;
c1: 0 ; saved value;
e. ; end procedure outbits;
a0: rs. w3 b1. ; entry:
ba w2 x2+1 ; next item:
bl w0 x2+1 ;
se w0 4 ; if item <> integer then
jl. a2. ; goto alarm;
al. w0 b5. ;
jl. w3 h31.-2 ; outtext (out, text);
rl w0 x2+2 ; integer:
rs. w0 g8. ; save outsegment;
jl. w3 h32.-2 ; write integer(zone, item);
1<23+ 32<12 +1 ; comment: layout for writeinteger;
ba w2 x2+1 ; next item:
bl w0 x2+1 ;
se w0 4 ; if item <> integer then
jl. a2. ; goto alarm;
al. w0 b6. ;
jl. w3 h31.-2 ; outtext (out, text);
rl w0 x2+2 ; integer:
rs. w0 g27. ; save outbase;
jl. w3 h32.-2 ; write integer(zone, item);
1<23+ 32<12 +1 ; comment: layout for writeinteger;
ba w2 x2+1 ; next item:
bl w0 x2+1 ;
se w0 4 ; if item <> integer then
jl. a2. ; goto alarm;
al. w0 b7. ;
jl. w3 h31.-2 ; outtext (out, text);
rl w0 x2+2 ; integer:
rs. w0 g0. ; save rel segment;
jl. w3 h32.-2 ; write integer(zone, item);
1<23+ 32<12 +1 ; comment: layout for writeinteger;
al. w0 b2. ;
jl. w3 h31.-2 ; outtext (out, text);
rl. w0 g0. ; rel segm :=
lo. w0 b11. ; rel segm or 1<11
ls w0 12 ; shift 12;
rs. w0 g0. ; save rel segm;
jl. w3 a1. ; outbits;
al. w0 b2. ;
jl. w3 h31.-2 ; outtext (out, text);
rl. w0 g0. ; get rel segm;
rl. w3 g8. ; abs own segment:
ws. w3 g27. ; curr segm :=
zl w0 0 ; outsegment - outbase;
wa w0 6 ; abs word :=
la. w0 b13. ; ((curr segm + rel segm) extract 11 +
wa. w0 g27. ; outbase);
jl. w3 h32.-2 ; write integer(zone, item);
1<23+ 32<12 +1 ; comment: layout for writeinteger;
al. w0 b2. ;
jl. w3 h31.-2 ; outtext (out, text);
rl. w0 g0. ; get rel segm;
el w0 0 ; abs own segment:
so w0 1<10 ; abs word := (if signbit pos then
la. w0 b13. ; abs word extract 11 else abs word) +
wa. w0 g8. ; outsegment *
jl. w3 h32.-2 ; write integer(zone, item);
1<23+ 32<12 +1 ; comment: layout for writeinteger;
al. w0 b8. ;
jl. w3 h31.-2 ; outtext (out, text);
rl. w0 g0. ; get rel segm;
rl. w3 g8. ; own point:
ws. w3 g27. ; curr segm :=
ea w3 0 ; outsegment - outbase;
la. w3 b13. ; bits (0, 11, point) :=
wa. w3 g27. ; (rel segm + curr segm) extract 11 + outbase;
al w0 x3 ;
jl. w3 h32.-2 ; write integer(zone, item);
1<23+ 32<12 +1 ; comment: layout for writeinteger;
al. w0 b8. ;
jl. w3 h31.-2 ; outtext (out, text);
rl. w0 g0. ; get rel segm;
bl w3 0 ;
so w3 1<10 ; own point:
la. w3 b13. ; bits (0, 11, point) :=
wa. w3 g8. ; (if signbit pos then w3 extract 11 else w3) +
al w0 x3 ; outsegment;
jl. w3 h32.-2 ; write integer(zone, item);
1<23+ 32<12 +1 ; comment: layout for writeinteger;
jl. w3 h34.-4 ; close up (out, nl);
jl. w3 h95.-2 ; terminate output: close up;
b3 = k + 1 ; fp result ; exit:
a5: al w2 0 ; w2 := fp result;
jl. h7. ; goto fp end program;
a2: al. w0 b0. ;
jl. w3 h31.-2 ; outtext (out, text);
al w2 1 ; warning.no, ok.no
hs. w2 b3. ;
jl. a5. ; exit;
b0: <:***testabsw param error<10><0>:>
b2: <:<10>absword = :>
b5: <:<10>outsegment = :>
b6: <:<10>outbase = :>
b7: <:<10>rel segm = :>
b8: <:<10>own point = :>
b1: 0 ; saved command pointer
b11: 1<11 ;
b13: 2047 ; 2.011111111111
g0: 0 ; rel segm;
g8: 0 ; outsegment;
g27: 0 ; outbase;;
b4=k-h55 ; length of message program
f1=b4
e. ; end segment:
m.rc 90.08.23 test abs word
g0:g1: (:f1+511:)>9 ; segm
0, r.4
s2 ; date
0,0 ; fil, block
2<12+4 ; contents, entry
f1 ; length
d.
p.<:insertproc:>
▶EOF◀