|
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: 9216 (0x2400)
Types: TextFile
Names: »writepltext«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦this⟧ »writepltext«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦dd2c1b53f⟧ »tplot«
└─⟦this⟧
(
scope temp writeplot plotz plotzd
clear temp writeplot plotz plotzd
writeplot=set 1
if 9.yes
(writeplot=slang fpnames type.yes list.no insertproc entry.no
writeplot plotz plotzd)
if 9.no
(writeplot=slang fpnames type.yes insertproc entry.no
writeplot plotz plotzd)
if ok.no
(c=message slang not ok writeplot
o c
end)
c=message slang ok writeplot
)
; HCØ 30 10 1972.
; Heinrich Bjerregaard.
; b. ; fpnames dummy block
b. g1,e20 ; block with names for tails
k=0 ; and insertproc.
m.writeplot
s. b6,c24,f6,g6,i24,j48 ; start of slang segment for proc.
h.
g0=2 ; g0:=no of externals;
e20:
g1: g3,g2 ; headword: rel of last point,
; rel of last abs word.
j3: g0+ 3, 0 ; RS entry 3, reserve
j6: g0+ 6, 0 ; RS entry 6, end register expression
j13: g0+13, 0 ; RS entry 13, last used
j30: g0+30, 0 ; RS entry 30, saved stack ref,saved w3
j41: 0, 1 ; RS entry to first word in perm core
j42: 0, c4 ; RS entry to first zone element
j43: 0, 9 ; RS entry to zone formal 2
j44: 0, 5 ; RS entry to last word in return inf.
j45: 1,b0 ; write,first ext.,chain for rel point
j46: 2,b1 ; plottext,second external, chain
g2=k-2-g1 ;
j47: 2,0 ; plottext,entry point
g3=k-2-g1
w.
e0: g0 ; start of externallist: no of externals
c3 ; number of bytes in own permanent
; core to be initialized.
; Saved variables during execution:
0,r.3 ; old return information
6<12+23, 0 ; zone formals
0,0 ; status, bytes transferred
; Buffer and share description:
i0: 0,r.(:h1-h0:)>1 ;
; Process description:
i2: 1<23+0 ; kind=internal process
<:plotintern:> ; process name
0,r.(:-k+2+i2+h2-h1:)>1
; Status handling:
i4: -1 ; give up mask
0,r.(:-k+2+i4+h3-h2:)>1
; Address of zone descriptor:
i6: ; it is assumed that h3=0
; Record description:
i8: 0,r.(:h4-h3:)>1 ;
i9: 1<22,r.3 ; scope parameters
; Fill up with zeros to the total length of the
; zone descriptor.
; 0,r.(:-k+2+i0+h5:)>1
; Share descriptor:
i10: 0,r.h6>1 ;
c1=48 ; record length in bytes
c2=i6-e0-4 ; rel address of zone descriptor
c3=k-e0-4 ; number of bytes to be initialized
c4=c3+1 ; rel addr of first zone element
c5=c1+c3 ; bytes in own permanent core
c7=i10-i6 ; distance from zone des to share des
; List of externals:
<:write:>,0,0 ; name
3<18+40<12+8<6,0 ; integer procedure(zone,general addr);
<:plottext:>,0 ; name
1<18+3<12+3<6+8,0 ; procedure(zone, integer, integer);
28 12 72, 12 00 00; date and time of this version
; Constants:
f0: 4<12+0 ; appetite increment
f1: 12<12+0 ; appetite increment
f2: 2<12+0 ; appetite increment
e1: rl. w2 (j13.) ; w2:=last used;
ds. w3 (j30.) ; saved stack ref, saved w3
rl. w3 j41. ;
al w3 x3+c2 ; w3:=absolute zone descriptor addr;
rs. w3 (j43.) ;
rs w3 x3+h4+0 ;
rl. w1 j42. ; Init zone:
al w1 x1-2 ;
rs w1 x3+h0+0 ; base buffer area
rs w1 x3+h3+0 ; record base
rs w1 x3+c7+2 ; first shared
rs w1 x3+c7+4 ; last shared
rs w1 x3+c7+22 ; top transferred
al w1 x1+c1-2 ;
rs w1 x3+h0+2 ; last of buffer
rs w1 x3+h3+2 ; last byte
al w1 x3+c7 ;
rs w1 x3+h0+4 ; used share
rs w1 x3+h0+6 ; first share
rs w1 x3+h0+8 ; last share
rl. w1 j47. ; set entry point(block proc);
rs w1 x3+h4+2 ;
al w1 1 ;
rs w1 x3+h2+4 ; partial word:=empty;
al w1 0 ;
rs w1 x3+h2+6 ; zone state:=after open;
i20: ; Continue:
al w1 -4 ; reserve 4 bytes in stack
jl. w3 (j3.) ; w1:=last used:=new stack top;
rl w0 x2 ;
rs. w0 (j41.) ; save old return point
dl w0 x2+4 ;
ds. w0 (j44.) ;
al w0 b2 ; set return inf in new stack top
rl w3 x1+8 ;
wa. w3 f0. ; adjust appetite accordingly
hl w3 1 ; rel addr of return to this segment
rs w3 x1+4 ;
rl. w3 g1. ; set segment table(writeplot);
ds w3 x1+2 ;
dl. w3 (j43.) ;
ds w3 x1+8 ; absolute address of zone descriptor
rl. w3 (j45.) ; w3:=segment table(write);
b0=k+1-g1
jl x3 ; goto write and
b2=k-g1 ; Return to here:
rl. w2 (j13.) ; w2:=last used;
ds. w3 (j30.) ; saved stack ref, saved w3
rl w1 x1 ;
rs w1 x2-2 ;
al w1 -20 ; reserve 20 bytes in stack
jl. w3 (j3.) ; w1:=last used:=new stack top;
rs w2 x1 ;
rl. w2 j41. ; w2:=absolute addr of own perm core;
al w0 b3 ;
wa. w0 f1. ; set appetite, the last two bytes must not be
rl. w3 g1. ; released by the block-proc -- they
ds w0 x1+4 ; contain the number of characters printed by this call.
dl. w0 (j43.) ; build up parameter-formals to the
ds w0 x1+8 ; block-proc call.
al w2 x2+10 ; first formals: zone des
rs w2 x1+12 ; second formal.2:=address of status;
al w2 x2+2 ;
rs w2 x1+16 ; third formal.2:=address of bytes transferred;
rl w3 0 ; w3:=absolute zone des address;
al w0 26 ; kind:=26;(integer);
rs w0 x1+10 ; second formal.1:=kind;
rs w0 x1+14 ; third formal.1:=kind;
rl w0 x3+h3+0 ; Close zone:
rl w1 x3+h2+4 ;
sn w1 1 ; if partial word<>empty then
jl. i22. ; begin
ns w1 0 ; justify left the partial word
ls w1 2 ;
al w0 2 ;
wa w0 x3+h3+0 ; z(record base + 2):=partial word;
rs w1 (0) ;
al w1 1 ; partial word:=empty;
rs w1 x3+h2+4 ; end;
i22: ws w0 x3+h0+0 ; bytes transferred:=
rs w0 x2 ; record base - base buffer area;
rl w1 x3+c7+2 ;
rs w1 x3+h3+0 ; record base:=first shared;
al w1 0 ;
rs w1 x3+h2+6 ; zone state: after open
am (0) ;
rs w1 x3+c7+h6 ; z(bytes transferred shift (-2)+2):=0;
al w1 c1 ;
rs w1 x3+h3+4 ; record length
rl. w3 (j46.) ; w3:=segment table(block proc);
b1=k+1-g1
jl x3 ; goto block proc and
b3=k-g1 ; Return to here;
rl. w2 (j13.) ; w2:=last used;
ds. w3 (j30.) ; saved stack ref, saved w3
al w1 -6 ; reserve 6 bytes in stack
jl. w3 (j3.) ;
rl. w2 j41. ; build up a point
rl w0 x2 ; only used by: end register expr.
rs w0 x1 ;
dl w0 x2+4 ;
bz w0 1 ;
wa. w0 f2. ;
ds w0 x1+4 ;
rl w1 x1+6 ; writeplot:=number of char mod c1 printed;
jl. (j6.) ; end register expr.
e18=c2
e19=c5
h. 0,r.(:504-k:) ; fill up the segment
w. <:writeplot <0>:>; alarm text
e. ; end slang segment
w.
; writeplot:
g0:
1 ; first tail : area with 1 segment
0,0,0,0 ; fill
1<23+e1-e20 ; entry point: writeplot
3<18+40<12,0 ; integer procedure(general address);
4<12+e0-e20 ; code proc, start of externallist
1<12+e19 ; 1 code segment, bytes in own perm core
;plotz:
1<23+4 ; modekind=bs
0,0,0,0 ; fill
e18+1 ; byte in own
14<18,0 ; zone plotz
4<12+e0-e20 ; code proc, start external
1<12+e19 ; 1 code segment, bytes in own
;plotzd:
g1: 1<23+4 ; modekind=bs
0,0,0,0 ; fill
9 ; byte in own
9<18,0 ; integer plotzd
4<12+e0-e20 ; code proc, start external
1<12+e19 ; 1 code segment, bytes in own
n.
▶EOF◀