|
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: 14592 (0x3900)
Types: TextFile
Names: »tremoveupdi «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »tremoveupdi «
(removeupdi=slang list.no
removeupdi
end)
; procedure removeupdi ( name );
; undefined name ;
;
; flemming biggas april 1988.
; flemming biggas januar 1988.
; flemming biggas august 1985.
;
; b.h100 dummy block fpnames
;
b. g1, e5 w.
k=10000
d.
p.<:fpnames:>
l.
s. c20
w.
b. j100
j0=3 ; 3 externals
h.
c1:e5:c2 , c3 ; head word
j1: 0 , 1 ; own core: result
j13: j0+13 , 0 ; rs entry last used
j29: j0+29 , 0 ; rs entry param alarm
j30: j0+30 , 0 ; rs entry saved stack ref
j3: j0+3 , 0 ; rs entry reserve
j6: j0+6 , 0 ; rs entry end register express.
j4: j0+4 , 0 ; rs entry take expression
j16: j0+16 , 0 ; rs entry segment table base
j21: j0+21 , 0 ; rs entry general alarm
j61: 1<11+1 , 0 ; segment table address next segment
c2=k-2-c1
c3=k-2-c1
w.
e0: 3 ; 3 externals
0 ; 0 own bytes
<:open:>,0,0, 1<18+19<12+41<6+19 , 8<18+0
<:close:>,0,0, 1<18+18<12+8<6+0 , 0
<:startfilei:>, 1<18+8<12+0 , 0
s3,s4 ; end external list
b. a40, b40 , f40 ; local names
w.
; organization of stack extension during call:
f0 = + 0 ; saved stack ref;
f1 = f0 + 2 ; mess operation
f2 = f1 + 2 ; mess first address
f3 = f2 + 2 ; mess last address
f4 = f3 + 2 ; mess segment number
f5 = f4 + 2 ; answer status
f6 = f5 + 2 ; answer remaining words
f7 = f6 +14 ; docname
f8 = f7 +10 ; start i/o area
f9 = f8+510 ; top i/o area
f10= f9+2 ; zone descriptor address (<>0 if param=zone)
f11= f10+2 ; last used (after reserve)
f12= f11-f0+2; no of halfwords to reserve in stack
b0: 0,r.10 ; area for lookup entry
b3: 0 ; saved return in check
b18: <:<32><32><32>:>; mask for non zero chars
b15: 2.11111; mask for kind
b16: 0 ; saved segment table entry of string point;
b17: 0 ; saved relative of string point;
b19: 6<12+23; param=zone
b21: 3<12+0; input
b22: 5<12+0; output
b24: <:<10>upd.mark:>
b25: <:<10>lookup :>
b26: <:<10>kind :>
b27: <:<10>contents:>
b28: <:<10>z.state :>
b29: <:<10>reserve :>
b30: <:<10>status :>
e1: rl. w2 (j13.) ; get last used
ds. w3 (j30.) ; save stackref
al w1 -f12 ; reserve room for i/o e.t.c. in stack
jl. w3 (j3.) ; init stack for i/o:
rs w1 x1+f11 ; save stack top;
rs w2 x1+f0 ; save stack ref from call;
al w2 x1+f8 ; first address;
rs w2 x1+f2 ;
al w2 x1+f9 ; last address;
rs w2 x1+f3 ;
ld w0 100 ;
rs w0 x1+f4 ; segno:= 0;
ds w0 x1+f7+2 ; docname(1):= 0;
ds w0 x1+f7+6 ; docname(2):= 0;
rs w0 x1+f7+8 ; name table address:=0;
rs w0 x1+f10 ; zone descriptor address := 0;
a2: rl. w1 (j13.) ; get param: w1:= last used;
rl w2 x1+f0 ; get param: w2:= saved stackref;
dl w1 x2+8 ; w0w1:= first formal
la. w0 b15. ; isolate kind
sn w0 24 ; if string variable
jl. a1. ; goto string;
sn w0 8 ; if expression then
jl. a0. ; goto take expression
dl w1 x2+8 ; if param<>zone then
sn. w0 (b19.) ;
jl. a10. ;
jl. w3 (j29.) ; call param alarm
a0: dl w1 x2+8 ; string expression:
jl. w3 (j4.) ; take expression;
ds. w3 (j30.) ; save stack ref;
a1: dl w0 x1 ; string:
sh w3 -1 ; if layout string then
jl. w3 (j29.) ; goto param error;
sh w0 -1 ; if short string then
jl. a6. ;
jl. w1 a3. ; save and check;
jl. a0. ; goto take expression;
a6: zl w0 6 ; string point: w0:= segno;
ls w0 1 ;
rl. w2 (j16.) ; w2:= segm table (segno);
wa w2 0 ;
rs. w2 b16. ; save segm table entry
zl w2 7 ; w2:= relative string point;
a5: rl. w3 (b16.) ; next portion: w3:= address (relative string point);
hs. w2 3 ; modify next address with relative string point;
dl w0 x3+0 ; w3w0:= string portion;
sh w0 -1 ; if point then
jl. a6. ; goto string point;
jl. w1 a3. ; save and check;
al w2 x2-4 ; relative := relative -4;
jl. a5. ; goto next portion;
0,0 ; return address,saved w2;
a3: ds. w2 a3.-2 ; save and check:
rl. w1 (j13.) ; w1:= stack reference;
rl w2 x1+f7 ; if docname (1) = real <::> then
sn w2 0 ;
am -4 ; docname(1):= w3w0 else
ds w0 x1+f7+6 ; docname(2):= w3w0;
la w3 0 ; if end of text then
so. w3 (b18.) ;
jl. a4. ; goto check entry
dl. w2 a3.-2 ;
jl x1 ; else return;
a10: rl. w3 (j13.) ; zone parameter:
rs w1 x3+f10 ;
rl w2 2 ; w2:=zone descriptor
rl w1 x2+h2+6 ; if zone state<>10 then
sn w1 +10 ; alarm (z.state);
jl. +6 ;
al. w0 b28. ;
jl. w3 (j21.) ;
rl. w3 (j13.) ; w3:= saved stack ref;
al w2 x2+h1+2 ; for i:= 1, 2 do
dl w1 x2+2 ; docname(i):= z.docname(i);
ds w1 x3+f7+2 ;
dl w1 x2+6 ;
ds w1 x3+f7+6 ;
;
a4: rl. w3 (j13.) ; check entry:
al w3+x3+f7 ;
al. w1 b0. ;
jd 1<11+42; lookup entry
se w0 0 ; if -, found then
jl. a20. ; goto alarm (not found) else
rl. w0 b0. ; if not area then
sh w0 0 ; goto alarm (not area)
jl. a21. ; else
zl. w0 b0.+16 ; if content key<>22 then
se w0 22 ;
jl. a22. ; goto alarm (contents);
jd 1<11+52; create (area process);
jd 1<11+8 ; reserve (process);
se w0 0 ; if ok.no then
jl. a23. ; goto alarm (reserve);
rl. w0 b21. ; operation:=input;
rl. w1 (j13.) ; w1:= last used;
rs w0 x1+f1 ;
al w0 0 ; segno := 0;
rs w0 x1+f4 ;
jl. w3 a31. ; send and check
rl. w3 (j13.) ; w3:= last used;
rl w2 x3+f2 ; w2:=buffer start
rl w1 x2 ;
al w1 x1+147 ;
al w1 x1-1 ;
as w1 -9 ;
al w1 x1+1 ; w1 := segno of update mark
sn w1 0 ; if <> current segment then
jl. a12. ; begin
rs w1 x3+f4 ; segno:=w1;
jl. w3 a31. ; send and check
a12: rl. w3 (j13.) ; w3:= last used;
rl w2 x3+f2 ; w2:=buffer start;
rl w1 x2+14 ; w1:=update mark
rs. w1 (j1.) ; result:=w1;
sh w1 +1 ; if w1>1 then
jl. a13. ;
al. w0 b24. ; alarm(w1,updatemark);
jl. w3 (j21.) ;
a13: al w1 0 ; delete update mark
rs w1 x2+14 ;
rl. w0 b22. ; operation:=output;
rs w0 x3+f1 ;
jl. w3 a31. ; send and check
rl. w3 (j13.) ; w3:= last used;
rl w2 x3+f10 ; w2:= zone param (<>0 = yes)
al w1 +f12 ; release bytes from stack
jl. w3 (j3.) ;
sn w2 0 ; if w2=<>0 then
jl. a14. ; begin comment zone param;
rl. w0 b19. ; w0:= first formal zone param;
al w1 x2 ; w1:= zone descr. address;
rl. w3 (j61.) ; w3 segment table address
jl x3+c8 ; goto rel c8 on next segment
; end
a14: rl. w3 (j13.) ; remove process:
al w3 x3+f7 ;
jd 1<11+64;
al w0 0 ;
rl. w1 (j1.) ; w0w1:=result;
jl. (j6.) ; return
a20: al. w1 b25. ;
jl. a30. ;
a21: al. w1 b26. ;
jl. a30. ;
a22: al. w1 b27. ;
jl. a30. ;
a23: al. w1 b29. ;
jl. a30. ;
a30: rx w1 0 ;
jl. w3 (j21.) ; alarm
a31: rs. w3 b3. ; save and check: save return ;
rl. w3 (j13.) ;
al w1 x3+f1 ; w1 := address (mess area);
al w3 x3+f7 ; w3 := address (docname);
jd 1<11+16 ; send message ;
rl. w3 (j13.) ;
al w1 x3+f5 ; w1 := address (answer area);
jd 1<11+18 ; wait answer;
rl w2 0 ; status :=
al w0 1 ; 1 < result
ls w0 x2 ; if normal answer then
sn w0 2 ; status := status
lo w0 x1 ; or answer.status;
se w0 2 ; if status <> 0 then
jl. a32. ; goto status_alarm;
rl w2 x1+2 ;
rl. w3 b3. ; w3 := return;
sn w2 512 ; if halfwords = 512 then
jl x3 ; goto return else
jl. a31. ; goto repeat;
a32: rl w1 0 ; status alarm: w1 := status;
al. w0 b30. ;
jl. w3 (j21.) ; general alarm (<:status:>, w1);
i.e. ; end a and b names
e. ; end j names
c4:
c.c4-c1-506
m.code segment 0 too long
z.
c.502-c4+c1,jl -1,r. 252-(:c4-c1:)>1 z.
<:removeupdi0:>
\f
k=10000
b. j100
j0=3 ; 3 externals
h.
c5: c6 , c7 ; rel last point,rel last abs word
j1: 0 , 1 ; result
j3: j0+3 , 0 ; rs entry reserve
j4: j0+4 , 0 ; rs entry take expression
j6: j0+6 , 0 ; rs entry end register expression
j13: j0+13 , 0 ; rs entry last used
j30: j0+30 , 0 ; rs entry saved stack ref
c7=k-2-c5
j70: 1 , 0 ; 1st external open
j71: 2 , 0 ; 2nd external close
j72: 3 , 0 ; 3rd external startfilei
c6=k-2-c5
b. a20, b20
w.
0
b0: 0, r.10
c8=k-c5
rs w1 4 ; at entry w0w1=formals descr. zone param
al w1 -10 ; reserve ( 10 bytes )
jl. w3 (j3.) ; during create call formals are saved in w0 and w2;
al w3 x2 ; w2,w3:= zone formals from call;
rl w2 0 ; stack+0 : formal 1 zone param
ds w3 x1+2 ; stack+2 : formal 2 - -
al w2 +25 ; stack+4 : formal 1 boolean
rs w2 x1+4 ; stack+ 6: address boolean
al w2 x1+8 ; stack+ 8: boolean :=
rs w2 x1+6 ; 0 ( false )
al w0 0 ;
rs w0 x1+8 ;
al w0 x1 ; w0 = stack ref
ls w0 4 ; ls 4
rl. w1 j71. ; w1 = point (close);
dl. w3 (j30.) ;
jl. w3 (j4.) ;
ds. w3 (j30.) ;
al w1 10 ; release from stack
jl. w3 (j3.) ;
rl. w2 (j13.) ; w2 = last used
al w1 -38 ; reserve 38 bytes
jl. w3 (j3.) ; in stack
dl w0 x2+8 ; w3w0 = formals zone
ds w0 x1+2 ; stack+ 2: formals zone
rl w2 0 ; w2:= zone descr.
al w2 x2+h1+4 ; w2 = zonedescr.name
dl w0 x2 ; w3w0 := zone.name(1);
ds w0 x1+24 ; stack+24: name(1);
dl w0 x2+4 ; w3w0 := zone.name(2);
ds w0 x1+28 ; stack+28: name(2);
al w3 26 ; stack+6: formals integer
al w0 x1+18 ;
ds w0 x1+6 ;
al w0 +4 ; integer := 4;
rs w0 x1+18 ;
al w3 +4 ; dope address=4
ls w3 +12 ; formal 1:= dope address < 12
al w3 x3+19 ; + 19
al w0 x1+32 ;
ds w0 x1+10 ;
al w3 +26 ; stack+14: formals intger
al w0 x1+16 ;
ds w0 x1+14 ;
al w0 +0 ; intger := 0;
rs w0 x1+16 ;
al w3 x1+29 ; array description
al w0 x1+21 ;
ds w0 x1+32 ;
al w3 +8 ;
al w0 +0 ;
ds w0 x1+36 ;
rs w0 x1+20 ;
al w0 x1 ; w0 stack ref
ls w0 +4 ;
rl. w1 j70. ; w0w1 := point open;
dl. w3 (j30.) ;
jl. w3 (j4.) ;
ds. w3 (j30.) ;
al w1 38 ;
jl. w3 (j3.) ; release bytes in stack
al w2 x1 ; w2:=param stack
al w1 -4 ; reserve 4 bytes in stack
jl. w3 (j3.) ;
dl w0 x2+8 ; transfer zone param to
ds w0 x1+2 ; new stack
dl. w3 (j30.) ;
al w0 0 ;
rl. w1 j72. ; w0w1 := point startfilei
jl. w3 (j4.) ; call startfilei;
ds. w3 (j30.) ;
al w1 4 ; release stack
jl. w3 (j3.) ;
al w0 0
rl. w1 (j1.) ; w0w1:=result
jl. (j6.) ;
c9:
c.c9-c5-506 m.code segment 1 too long
z.
c.502-c9+c5,jl -1, r.252-(:c9-c5:)>1 z.
<:removeupdi1<0>:>
e. ; end a20,b20 block
i.e.
i.e.
w.
g0:g1: 2 ; 2 segments on disc
0,0,0,0 ; room for docname
1<23+e1-e5 ; entry point on segment 0
3<18+41<12,0 ; integer procedure, one param:undefined
4<12+e0-e5 ; algol procedure, start external list
2<12+2 ; 2 code segments, 2 bytes in own core
m.removeupdi 4.0 (sw8201/1 15.2) fb.1988.02.11
d.
p.<:insertproc:>
end
▶EOF◀