|
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: 16128 (0x3f00)
Types: TextFile
Names: »procsurv3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »procsurv3tx «
; ta 76.08.06 procsurvey, page ...1...
s. a7, b6, c14, d12, e2, f5, g2
w.
d.
p.<:fpnames:>
l.
k=h55
al w1 x3+2 ;
rs. w1 c0. ; save progname addr
se w3 x2 ; if left hand side then
jl. a0. ; alarm(<:call:>);
d7: al w3 x3+10 ; save param pointer;
rs. w3 c6. ;
al w3 x3+2 ;
rs. w3 c1. ; save param addr.
al. w1 h19. ; w1:=addr(cur prog zone);
jl. w3 h79. ; terminate zone;
al. w3 c7. ; first shared(cur prog zone):=
rs. w3 h80.+2 ; addr of buffer start;
al w3 x3-1 ; base buf(cur prog zone):=
rs w3 x1+10 ; first of buffer-1;
al w3 x3+512 ; last buf(cur prog zone):=
rs w3 x1+h0+2 ; base buf+512;
d0: al. w1 h54. ; next: w1:=lookup area
al. w3 (c1.) ; w3:=name addr
jd 1<11+42 ; lookup name;
se w0 0 ; if not found then
jl. a2. ; alarm(unknown:>);
bz w2 x1+16 ;
se w2 4 ;
sl w2 32 ; if contents<>4 and contents<32 then
jl. 4 ; alarm(<:not procedure:>);
jl. a3. ;
al w2 x2-32 ; if contents>=32 then
sh w2 0 ; segm:=contents-32;
al w2 0 ;
rs. w2 c14. ;
rl w0 x1+12 ;
rs. w0 c8. ; save param spec 1
rl w0 x1+14 ;
rs. w0 c9. ; save param spec 2.
al w2 10 ; outnl;
jl. w3 h26.-2 ;
rl. w1 c8. ;
ls w1 -18 ; w1:=procedure type;
sl w1 15 ;
al w1 0 ;
wm. w1 b5. ;
al. w0 x1+f2. ; outtext
jl. w3 h31.-2 ; (actual type);
rl. w0 c1. ;
jl. w3 h31.-2 ; outtext(procname);
\f
; ta 78.03.07 procsurvey, page ...2...
al. w1 h54. ; restore w1;
al. w3 (c1.) ;
rl w2 x1 ;
se w2 0 ; if variable then
jl. d1. ; begin
rl. w2 c8. ;
ls w2 6 ;
sn w2 0 ; if rs entry then
jl. d9. ; begin
al. w0 f3. ;
jl. w3 h31.-2 ; outtext(rs entry no);
am 1 ;
bz. w0 c8. ;
jl. w3 h32.-2 ; outinteger(rs no);
1 ;
d9: al w2 10 ; outnl;
jl. w3 h26.-2 ; goto nextparam;
jl. d4. ; end end;
d1: bz w0 x1+17 ; connect:
rs. w0 c2. ; c2:=externallist
sl w0 502 ; if startexternallist>500 then
jl. a5. ; alarm(<:entry inconsistent:>);
al. w1 h19. ;
al w2 x3 ; connect param to
jl. w3 h27. ; cur prog zone;
se w0 0 ; if connect error then
jl. d6. ; goto subentry;
rl. w0 c14. ;
rs. w0 h19.+h1+16; set segm;
jl. w3 h22. ; inblock;
rl. w0 h54. ; bs then
sl w0 0 ; begin
jl. d10. ;
al. w1 h54. ; lookup docname;
al. w3 h54.+2 ;
jd 1<11+42 ;
bz. w0 h54.+17 ; end;
rl. w1 c2. ; if startext=0 then
sn w1 0 ; startext:=byte17;
rs. w0 c2. ;
sl w0 502 ; if startext>500 then
jl. a5. ; alarm(entry inconsistent);
d10: rl. w2 c2. ;
am. c7. ;
bz w1 x2+1 ; addr:=z(startext) extract 12
wm. w1 b0. ; *12
rs. w1 c3. ; +
am. c7. ;
bz w1 x2 ; z(startadr) shift (-12)
ls w1 1 ; *2
am. c7. ;
ba w1 x2+3 ; + own bytes
wa. w1 c3. ;
al w1 x1+6 ; +6
wa. w1 c2. ; +startext;
al. w1 x1+c7. ;
rs. w1 c3. ;
d11: rl w0 x1 ; nextsegm:
rs. w0 c5. ; save clock;
rl w0 x1-2 ;
rs. w0 c4. ; save date;
\f
; ta 78.03.07 procsurvey, page ...3...
am. c7. ;
sh w1 500 ; if addr<=500 then
jl. d2. ; print_date_and_clock;
al w0 0 ;
am. c7. ;
sn w1 502 ; if addr=502 then
rs. w0 c2. ; startext:=0;
rl. w1 h54. ;
al w1 x1-1 ; seg:=seg-1;
rs. w1 h54. ;
am. c7. ;
bz w2 503 ; w1:=continueaddr
sl w1 0 ; if seg<0 or
sl w2 500 ; if continueaddr>500 then
jl. a7. ; alarm<:code inconsistent:>);
al w1 x2-502 ; addr:=continueadr-502
wa. w1 c3. ; +addr
rs. w1 c3. ;
al. w1 h19. ;
jl. w3 h22. ; inblock;
rl. w1 c3. ;
rl. w0 c2. ; if startext=500
se w0 500 ; then
jl. d12. ; begin
am. c7. ; addr:=addr
ba w1 x2+1 ; +own bytes
ws w1 4 ; -continueaddr;
al w0 2 ; startext:=2;
rs. w0 c2. ; end;
d12: am. c7. ;
sl w1 502 ; if addr>500 then
jl. d11. ; goto nextsegm;
rl w0 x1 ;
rs. w0 c5. ; save clock;
rl w1 x1-2 ;
rl. w0 c2. ; if startext<>0 then
se w0 0 ; save date;
rs. w1 c4. ;
d2: al. w0 b2. ; print_date_and_clock;
jl. w3 h31.-2 ; outtext(<: d.:>);
rl. w0 c4. ;
jl. w3 h32.-2 ; outinteger(date);
48<12+6 ; <<zddddd>
al w2 46 ;
jl. w3 h26.-2 ; outpoint;
rl. w0 c5. ;
al w3 0 ; clock:=clock/100;
wd. w0 b1. ;
jl. w3 h32.-2 ; outinteger(clock);
48<12+4 ; <<zddd>
al w2 10 ;
jl. w3 h26.-2 ; outnl;
d8: al. w3 c13. ; after date: w3:=store addr;
al w1 0 ;
rl. w0 c9. ; w0:=param spec2;
ld w1 -6 ;
ls w1 -18 ; w1:=first param;
rs w1 x3 ;
se w1 0 ;
al w3 x3+2 ; count param;
ld w1 -6 ;
ls w1 -18 ; w1:=param 2;
rs w1 x3 ;
se w1 0 ; count param;
al w3 x3+2 ;
ld w1 -6 ;
ls w1 -18 ; w1:=param 3;
rs w1 x3 ;
se w1 0 ; count param;
al w3 x3+2 ;
rs w0 x3 ;
se w0 0 ; w0:=param 4;
al w3 x3+2 ; count param;
al w1 0 ;
\f
; ta 77.08.29 procsurvey, page ...4...
rl. w0 c8. ; w0:=param spec1;
ld w1 -6 ;
ls w1 -18 ; w1:=param5;
rs w1 x3 ;
se w1 0 ; count param;
al w3 x3+2 ;
ld w1 -6 ;
ls w1 -18 ;
rs w1 x3 ; w1:=param6;
se w1 0 ;
al w3 x3+2 ; count param;
ld w1 -6 ;
ls w1 -18 ; w1:=param7;
rs w1 x3 ;
se w1 0 ; count param
al w3 x3+2 ;
rs. w3 c10. ; save pointer last;
al w1 0 ;
rs. w1 c11. ; cur param:=0;
al. w1 c13. ;
rs. w1 c12. ;
d3: rl. w1 c10. ; print loop:
sn. w1 (c12.) ; if last if printed
jl. d4. ; then goto next param;
al. w0 f4. ;
jl. w3 h31.-2 ; outtext(param)
rl. w0 c11. ;
ba. w0 1 ; curparam:=curparam+1;
rs. w0 c11. ;
jl. w3 h32.-2 ; outinteger(curparam);
1 ;
rl. w1 (c12.) ;
sl w1 42 ;
al w1 0 ;
wm. w1 b6. ; addr. param type
al. w0 x1+f5. ;
jl. w3 h31.-2 ; outtext(paramtype);
rl. w1 c12. ;
al w1 x1+2 ; curadr:=curadr+2;
rs. w1 c12. ;
jl. d3. ;
d4: rl. w1 c6. ; nextparam:
ba w1 x1+1 ; param pointer;
rs. w1 c6. ;
al w1 x1+2 ;
rs. w1 c1. ; adr. cur param;
rl. w1 c6. ; if -,endparam
bl w1 x1 ;
sl w1 4 ; then
jl. d0. ; goto next;
d5: al w2 0 ; ok
jl. h7. ; goto fp;
\f
; ta 76.08.06 procsurvey, page ...5...
d6: al. w3 c13. ; subentry:
dl. w1 h54.+4 ;
ds w1 x3+2 ; move docname;
dl. w1 h54.+8 ;
ds w1 x3+6 ;
al. w1 h54. ;
jd 1<11+42 ; lookup docname;
se w0 0 ; if not found then
jl. a6. ; not connected;
bz w2 x1+16 ; if contents>=32 then
al w2 x2-32 ; segm:=contents-32;
sl w2 0 ;
rs. w2 c14. ;
jl. d1. ; goto connect;
a0: jl. w2 e0. , <: call:>
a1: jl. w2 e0. , <: param:>,0
a2: jl. w2 e0. , <: unknown:>
a3: jl. w2 e0. , <: not procedure:>
a5: jl. w2 e0. , <: entry inconsistent:>
a6: jl. w2 e0. , <: connect error:>
a7: jl. w2 e0. , <: code inconsistent:>,0
e0: ds. w3 c5. ; save w2, w3
al. w0 b3. ;
jl. w3 h31.-2 ; outtext(<:***:>);
rl. w0 c0. ;
jl. w3 h31.-2 ; outtext(progname);
sn. w2 a0.+2 ;
jl. e1. ; if -,call alarm then
al. w0 b4. ; begin
jl. w3 h31.-2 ; outtext<: :>);
rl. w1 c6. ;
bz w1 x1+1 ;
se w1 10 ; if textparam then
jl. e2. ;
rl. w0 c1. ;
jl. w3 h31.-2 ; outtext(param);
jl. e1. ; else
e2: rl. w0 (c1.) ;
jl. w3 h32.-2 ; outinteger(param);
1 ;
al. w2 a1.+2 ;
e1: al w0 x2 ; end;
jl. w3 h31.-2 ; outtext(error cause);
al w2 10 ;
jl. w3 h26.-2 ; outnl;
al w2 1 ;
hs. w2 d5.+1 ; ok.no
dl. w3 c5. ; restore w2, w3
sn. w2 a0.+2 ; if call alarm then
jl. d7. ; continue;
sh. w2 a5. ; if not procedure then
jl. d4. ; goto nextparam
jl. d8. ; else goto after date;
b0: 12 ;
b1: 100 ;
b2: <:: d.:> ;
b3: <:<10>***:> ;
b4: <: :> ;
b5: 16 ;
b6: 16 ;
\f
; ta 76.08.06 procsurvey, page ...6...
c0: 0 ; prog name addr
c1: 0 ; param addr
c2: 0 ; startext
c3: 0 ; wrk for addr calc.
c4: 0 ; date
c5: 0 ; clock
c6: 0 ; param pointer
c8: 0 ; param spec 1;
c9: 0 ; param spec 2;
c10: 0 ; pointer last param;
c11: 0 ; cur proc param
c12: 0 ; cur addr
c13: 0,0,0,0,0,0,0 ; parameter types
c14: 0 ; segm
f2: <: illegal type :> ,0,0,0
<: no type procedure :> ,0
<: boolean procedure :> ,0
<: integer procedure :> ,0
<: real procedure :> ,0,0
<: long procedure :> ,0,0
<: long real procedure :>
<: complex procedure :> ,0
<: boolean :> ,0,0,0,0
<: integer :> ,0,0,0,0
<: real :> ,0,0,0,0,0
<: long :> ,0,0,0,0,0
<: long real :> ,0,0,0,0
<: complex :> ,0,0,0,0
<: zone :> ,0,0,0,0
f3: <:, rs entry no.: :>
f4: <: param :>
f5: <:: illegal type<10>:> ,0,0,0
<:: illegal type<10>:> ,0,0,0
<:: boolean<10>:> ,0,0,0,0
<:: integer<10>:> ,0,0,0,0
<:: real<10>:> ,0,0,0,0,0
<:: long<10>:> ,0,0,0,0,0
<:: long real<10>:> ,0,0,0,0
<:: complex<10>:> ,0,0,0,0
<:: zone<10>:> ,0,0,0,0,0
<:: string<10>:> ,0,0,0,0,0
<:: label<10>:> ,0,0,0,0,0
<:: illegal type<10>:> ,0,0,0
<:: value boolean<10>:> ,0,0
<:: value integer<10>:> ,0,0
<:: value real<10>:> ,0,0,0
<:: value long<10>:> ,0,0,0
<:: value long real<10>:> ,0,0
<:: value complex<10>:> ,0,0
\f
; ta 76.08.16 procsurvey, page ...7...
<:: addr boolean<10>:> ,0,0,0
<:: addr integer<10>:> ,0,0,0
<:: addr real<10>:> ,0,0,0,0
<:: addr long<10>:> ,0,0,0,0
<:: addr long real<10>:> ,0,0
<:: addr complex<10>:> ,0,0,0
<:: boolean array<10>:> ,0,0
<:: integer array<10>:> ,0,0
<:: real array<10>:> ,0,0,0
<:: long array<10>:> ,0,0,0
<:: long real array<10>:> ,0,0
<:: complex array<10>:> ,0,0
<:: zone array<10>:> ,0,0,0
<:: no type procedure<10>:> ,0
<:: boolean procedure<10>:> ,0
<:: integer procedure<10>:> ,0
<:: real procedure<10>:> ,0,0
<:: long procedure<10>:> ,0,0
<:: long real procedure<10>:>
<:: complex procedure<10>:> ,0
<:: switch<10>:> ,0,0,0,0,0
<:: general<10>:> ,0,0,0,0
<:: general addr<10>:> ,0,0,0
<:: undefined<10>:> ,0,0,0
c7: 0 ; base buf
m. rc 1977.08.29 procsurvey
g2=k-h55
g0:g1: (:g2+511:)>9 ; segms.
0, r.4 ; docname
s2 ; date
0, 0 ; file, block
2<12 ; contry
g2 ; load length
m.rc 1978.03.07 procsurvey
d.
p.<:insertproc:>
▶EOF◀