|
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: 5376 (0x1500)
Types: TextFile
Names: »message3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »message3tx «
; rc 1976.05.21 fp utility, message, page ...1...
; the program is translated like
; (message=slang text entry.no
; message)
b. g1, f6 w. ; for insertproc
d.
p.<:fpnames:>
l.
s. a7, b4 ; begin segment: message;
w. ;
k = h55 ;
b4 , 0 ; length of program , empty word;
rs. w3 b1. ; entry:
bz w0 x3 ; save param pointer;
se w0 6 ; if no left hand side of call then
jl. a3. ; goto mess1;
jl. w3 h29.-4 ; secondary out:
am. (b1.) ; stack zone(current in);
al w2 -8 ; w2 := address(left hand side);
al. w1 h20. ; w1 := zone descr(current in);
al w0 1<1+1 ; if new area then one segment on disc;
jl. w3 h28. ; connect output;
se w0 0 ; if result = 0 then
jl. a6.
bl w0 x1+h1+1 ;
sn w0 4 ; if -,bs and
jl. 6 ; -,mt
se w0 18 ; then
jl. a4. ; skip;
al. w1 h54. ; w1:=lookup area
am. (b1.)
al w2 -8 ; w2:=name addr
jl. w3 a7. ; prepare output
jl. a4.
a6:
al. w0 b2. ; connect error:
jl. w3 h31.-2 ; writetext(out,<:***message connect error:>);
al w0 1 ; fp result := 1;
hs. w0 b3. ;
a3: am h21-h20 ; mess1: zone := current out else
a4: al. w1 h20. ; mess2: zone := current in;
rl. w2 b1. ; restore command pointer;
a0: ba w2 x2+1 ; next item:
bl w3 x2 ; next item;
al. w0 x3+b0. ;
jl. w3 h31. ; writetext(zone, separator);
bl w0 x2 ; test end:
sl w0 4 ; if -, end parameter list then
jl. a1. ; goto write item;
se. w1 h20. ; if zone <> current in then
jl. a5. ; goto exit;
jl. w3 h95. ; terminate output: close up;
jl. w3 h79.-4 ; terminate zone (current in);
\f
; rc 86.08.15 fp utility, message, page 2
bz w2 x1+h1+1 ; the outputfile must be reduced to the
al w3 x1+h1+2 ; absolute minimum, in case of backing storage:
al. w1 h54. ;
jd 1<11+42 ; lookup entry(outfilename, tailaddr);
rl w0 x3+14 ; tail(0) := segment count (output zone);
rs w0 x1 ;
al w0 0 ; contents := text;
rs w0 x1+16 ;
sn w2 4 ; if kind(output zone) = <bs> then
jd 1<11+44 ; change entry(outfile name, tail);
b3 = k + 1 ; fp result ; exit:
a5: al w2 0 ; w2 := fp result;
jl. h7. ; goto fp end program;
a1: bl w0 x2+1 ; write item:
sn w0 4 ; if integer item then
jl. a2. ; goto integer;
al w0 x2+2 ; text:
jl. w3 h31. ; writetext(zone, item);
jl. a0. ; goto next item;
a2: rl w0 x2+2 ; integer:
jl. w3 h32. ; write integer(zone, item);
1<23+127<12 +1 ; comment: layout for writeinteger;
jl. a0. ; goto next item;
b2: <:***message connect error<10><0>:>
b1: 0 ; saved command pointer
<:<10>:> ; -4 nl
<:<10>:> ; -2 nl
b0: <:<10>:> ; 0 nl
<:<10>:> ; 2 nl
<: :> ; 4 space
<:=:> ; 6 equal
<:.:> ; 8 point
a7:
; procedure prepare entry for textoutput
; w0 not used
; w1 lookup area
; w2 name addr, entry must be present
; w3 return addr
b. a2 w.
ds. w1 a1. ; save w0.w1
ds. w3 a2. ; save w2.w3
al w3 x2 ; w3:=name addr
jd 1<11+42 ; lookup
bz w2 x1+16 ;
sh w2 32 ; if contents=4 or
sn w2 4 ; contents>=32
jl. 4 ; then
jl. a0. ; file:=block:=0;
rs w0 x1+12 ;
rs w0 x1+14 ;
a0: rs w0 x1+16 ; contents.entry:=0;
rs w0 x1+18 ; loadlength:=0;
dl w1 110 ;
ld w1 5 ; shortclock;
rl. w1 a1. ;
rs w0 x1+10 ;
jd 1<11+44 ; changeentry;
dl. w1 a1. ; restore w0,w1
dl. w3 a2. ; restore w2,w3
jl x3 ; return
0 ; saved w0
a1: 0 ; saved w1
0 ; saved w2
a2: 0 ; saved w3
e.
b4=k-h55 ; length of message program
f1=b4
e. ; end segment: message
m.rc 86.08.15 fp utility, message
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:>
l.
\f
▶EOF◀