|
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: 26880 (0x6900)
Types: TextFile
Names: »procsurv4tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »procsurv4tx «
; fgs 1988.09.20 procsurvey, page ...1...
s. a30, b30, c30, d30, e30, f30, g30
w.
d.
p.<:fpnames:>
l.
k=h55
jl. w1 d20. ; init program;
jl. w3 d28. ; if left side then connect output;
d7: rs. w1 c18. ; save output zone address;
al. w1 h19. ; w1:=addr(cur prog zone);
jl. w3 h79. ; terminate zone;
am +2000 ;
al. w3 c27. ; 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 ;
ld w0 1 ; fortran :=
rs. w3 c15. ; spec 1.msb;
ls w0 -1 ;
rs. w0 c8. ; save param spec 1 extract 11;
rl w0 x1+14 ;
rs. w0 c9. ; save param spec 2.
\f
; fgs 1988.09.20 procsurvey, page ...2...
al w2 10 ; outnl;
rl. w1 c18. ; zone := spec out;
jl. w3 h26. ;
rl. w1 c8. ;
ls w1 -18 ; w1:=procedure type;
sl w1 15 ;
al w1 0 ;
wm. w1 b5. ;
rl. w3 c15. ;
sz w3 1 ; if fortran then
am f22 ; change text of actual type;
al. w0 x1+f2. ;
rl. w1 c18. ; zone := spec. out;
jl. w3 h31. ; outtext (actual type);
rl. w1 c1. ;
al. w2 c16. ;
dl w0 x1+2 ; move name
lo. w3 b11. ; from parameter area
lo. w0 b11. ; to saved procname
ds w0 x2+2 ; and
dl w0 x1+6 ; extend to 12 positions
lo. w3 b11. ; with spaces;
lo. w0 b12. ;
ds w0 x2+6 ;
al. w0 c16. ;
rl. w1 c18. ; zone := spec. out;
jl. w3 h31. ; outtext(procname);
\f
; fgs 1988.09.20 procsurvey, page ...3...
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. ;
rl. w1 c18. ; zone := spec. out;
jl. w3 h31. ; outtext(rs entry no);
am 1 ;
bz. w0 c8. ;
jl. w3 h32. ; outinteger(rs no);
32<12+3 ;
d9: al w2 10 ; outnl;
rl. w1 c18. ; zone := spec. out;
jl. w3 h26. ; goto nextparam;
jl. d4. ; end rs entry;
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;
\f
; fgs 1988.09.20 procsurvey, page ...4...
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 +2000 ;
am. c27. ;
bz w1 x2+1 ; addr:=z(startext) extract 12
wm. w1 b0. ; *12
rs. w1 c3. ; +
am +2000 ;
am. c27. ;
bz w1 x2 ; z(startadr) shift (-12)
ls w1 1 ; *2
wa. w1 c3. ;
rs. w1 c3. ; +
rl. w3 c15. ;
sz w3 1 ; if not fortran then
jl. d13. ;
am +2000 ;
am. c27. ;
rl w1 x2+2 ; no of bytes to copy
jl. d14. ; else
d13: am +2000 ;
am. c27. ;
zl w1 x2+2 ; no of commons *
wm. w1 b7. ; 6 +
am +2000 ;
am. c27. ;
zl w0 x2+3 ; no of zcommons *
wm. w0 b8. ; 9
wa w1 0 ;
d14: wa. w1 c3. ;
al w1 x1+6 ; +6
wa. w1 c2. ; +startext;
am +2000 ;
al. w1 x1+c27. ;
rs. w1 c3. ;
d11: rl w0 x1 ; nextsegm:
rs. w0 c5. ; save clock;
rl w0 x1-2 ;
rs. w0 c4. ; save date;
\f
; fgs 1988.09.20 procsurvey, page ...5...
am +2000 ;
am. c27. ;
sh w1 500 ; if addr<=500 then
jl. d2. ; print_date_and_clock;
al w0 0 ;
am +2000 ;
am. c27. ;
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 +2000 ;
am. c27. ;
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
rl. w3 c15. ; addr := addr +
sz w3 1 ; if not fortran then
jl. d15. ;
am +2000 ;
am. c27. ;
wa w1 x2+0 ; no of bytes to copy
jl. d16. ;
d15: am +2000 ;
am. c27. ;
zl w1 x2+0 ; no of commons *
wm. w1 b7. ; 6 +
am +2000 ;
am. c27. ;
zl w0 x2+1 ; no of zcommons *
wm. w0 b8. ; 9
wa w1 0 ;
wa. w1 c3. ;
d16: ws w1 4 ; -continueaddr;
al w0 2 ; startext:=2;
rs. w0 c2. ; end;
\f
; fgs 1988.09.20 procsurvey, page ...6...
d12: am +2000 ;
am. c27. ;
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;
rl. w1 c18. ; zone := spec. out;
jl. w3 h31. ; outtext(<: d.:>);
rl. w0 c4. ;
jl. w3 h32. ; outinteger(date);
48<12+6 ; <<zddddd>
al w2 46 ;
jl. w3 h26. ; outpoint;
rl. w0 c5. ;
al w3 0 ; clock:=clock/100;
wd. w0 b1. ;
jl. w3 h32. ; outinteger(clock);
48<12+4 ; <<zddd>
al. w0 b9. ; addr text :=
rl. w3 c15. ; if not fortran then
sz w3 1 ; addr <:algol:>
al. w0 b10. ; else
; addr <:fortran:>;
jl. w3 h31. ; outtext (text);
al w2 10 ;
jl. w3 h26. ; outnl;
\f
; fgs 1988.09.20 procsurvey, page ...7...
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 ;
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. ;
\f
; fgs 1988.09.20 procsurvey, page ...8...
d3: rl. w1 c10. ; print loop:
sn. w1 (c12.) ; if last if printed
jl. d4. ; then goto next param;
al. w0 f4. ;
rl. w1 c18. ; zone := spec. out;
jl. w3 h31. ; outtext(param)
rl. w0 c11. ;
ba. w0 1 ; curparam:=curparam+1;
rs. w0 c11. ;
jl. w3 h32. ; outinteger(curparam);
1 ;
rl. w1 (c12.) ;
sl w1 42 ;
al w1 0 ;
wm. w1 b6. ; addr. param type
rl. w3 c15. ;
sz w3 1 ; if fortran then
am f25 ; change text of param type;
al. w0 x1+f5. ;
rl. w1 c18. ; zone := spec. out;
jl. w3 h31. ; 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;
\f
; fgs 1988.09.20 procsurvey, page ...9...
d22: rl. w1 c18. ; look for sec. output:
se w1 0 ; if no sec zone
sn. w1 h21. ; or zone = cur out then
jl. d5. ; begin <*terminate sec out*>
bz w3 x1+h1+1 ;
se w3 4 ; char := if kind=bs
sn w3 18 ; or if kind=mt then em
am 25 ; else
al w2 0 ; null
jl. w3 h34. ; close up (char);
jl. w3 h79. ; terminate zone;
bz w0 x1+h1+1 ;
se w0 4 ; if kind = bs
jl. d23. ; begin <*cut down*>
al w3 x1+h1+2 ;
al. w1 c17. ; lookup entry(outfile);
jd 1<11+42 ; size(tail) :=
rl w0 x3+14 ; segment count;
rs. w0 c17. ; change entry;
jd 1<11+44 ; end <*cut down*>;
d23: am -2000 ;
rl. w3 h8.+2000 ; <*set content*>
al w3 x3+2 ;
al. w1 c17. ; lookup entry(outfile);
jd 1<11+42 ;
al w0 0 ;
am 16 ;
rs. w0 c17. ; content := text;
jd 1<11+44 ; change entry(outfile);
; end <*terminate sec. out*>
d5: al w2 0 ;
am -2000 ;
jl. h7.+2000 ; goto fp;
\f
; fgs 1988.09.20 procsurvey, page ...10...
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;
;procedure init program
;
;called just after entry nb: link w1
;
d20: al w3 x3+2 ; addr program name :=
rs. w3 c0. ; w3 at entry + 2;
al w2 x3+8 ; addr of first item :=
rs. w2 c6. ; addr program name + 8;
al w2 x2+2 ; addr of first param :=
rs. w2 c1. ; addr of program name + 10;
bz w2 x3-2 ;
se w2 6 ; return:=
am 2 ; if delim <> 6 then link+2
al w3 x1 ; else link;
al. w1 h21. ; w1:=addr of curr out zone;
jl x3 ; goto return;
\f
; fgs 1988.09.20 procsurvey, page ...11...
;connect special output zone
;
b. j4 ;
w.
j0: 0 ; save return
d28: rs. w3 j0. ;
jl. w3 h29.-4 ; stack curr in;
rl. w2 c0. ;
al w2 x2-10 ; w2:=addr(outfile name);
al w0 1<2+0 ;
jl. w3 h28. ; connect cur in (outfile);
se w0 0 ; if troubles theen
jl. a0. ; goto connect output alarm;
bl w0 x1+h1+1 ;
se w0 4 ; if not bs and
sn w0 18 ; not mt then
jl. d29. ; return;
jl. (j0.) ;
d29: al. w1 h54. ; w1:=lookup area;
rl. w2 c0. ;
al w2 x2-10 ;
jl. w3 d30. ; prepare output
al. w1 h20. ; w1:=cur in
jl. (j0.) ; return; comment: now w1
; points to cur out zone;
e. ; end of connect second out
\f
; fgs 1988.09.20 procsurvey, page ...12...
; procedure prepare entry for textoutput
; w0 not used
; w1 lookup area
; w2 name addr, entry must be present
; w3 return addr
b. a2 w.
d30: 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. ; end prepare entry for text output
\f
; fgs 1988.09.20 procsurvey, page ...12...
a0: jl. w2 e0. , <: connect <0>:>
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:>
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 -,connect output 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);
dl. w3 c5. ;
se. w2 a0.+2 ; if connect output alarm then
jl. d24. ; begin
rl. w2 c0. ; text addr := addr outfile param;
al w0 x2-10 ; addr outfile param;
jl. w3 h31.-2 ; outtext (curr out, text);
d24: al w2 10 ; end;
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 connect output alarm then
jl. d7. ; continue;
sh. w2 a5. ; if not procedure then
jl. d4. ; goto nextparam
jl. d8. ; else goto after date;
\f
; fgs 1988.09.20 procsurvey, page ...14...
b0 : 12 ;
b1 : 100 ;
b2 : <:: d.:> ;
b3 : <:<10>***:> ;
b4 : <: :> ;
b5 : 16 ;
b6 : 16 ;
b7 : 6 ;
b8 : 9 ;
b9 : <: (algol) <0>:> ;
b10: <: (fortran)<0>:> ;
b11: <:<32><32><32>:> ;
b12: <:<32><32><0>:> ;
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
c15: 0 ; boolean fortran
c16: 0, r.4 ; save procedure name
c17: 0, r.10 ; lookup area
c18: 0 ; sec. zone
\f
; fgs 1988.09.20 procsurvey, page ...15...
; <:--34567890123456789012-<0>:>
f2: <: illegal type <0>:>
<: no type procedure <0>:>
<: boolean procedure <0>:>
<: integer procedure <0>:>
<: real procedure <0>:>
<: long procedure <0>:>
<: long real procedure <0>:>
<: complex procedure <0>:>
<: boolean <0>:>
<: integer <0>:>
<: real <0>:>
<: long <0>:>
<: long real <0>:>
<: complex <0>:>
<: zone <0>:>
f12: <: illegal type <0>:>
<: subroutine <0>:>
<: logical function <0>:>
<: integer function <0>:>
<: real function <0>:>
<: long int. function <0>:>
<: double pr function <0>:>
<: complex function <0>:>
<: boolean <0>:>
<: integer <0>:>
<: real <0>:>
<: long <0>:>
<: long real <0>:>
<: complex <0>:>
<: zone <0>:>
f3: <:, rs entry no.: :>
f4: <: param :>
\f
; fgs 1988.09.20 procsurvey, page ...16...
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
<:: 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
\f
; fgs 1988.09.20 procsurvey, page ...17...
f15: <:: illegal type<10>:> ,0,0,0
<:: illegal type<10>:> ,0,0,0
<:: logical<10>:> ,0,0,0,0
<:: integer<10>:> ,0,0,0,0
<:: real<10>:> ,0,0,0,0,0
<:: long integer<10>:> ,0,0,0
<:: double precision<10>:> ,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 logical<10>:> ,0,0
<:: value integer<10>:> ,0,0
<:: value real<10>:> ,0,0,0
<:: value long integer<10>:>,0
<:: value double prec.<10>:>,0
<:: value complex<10>:> ,0,0
<:: addr logical<10>:> ,0,0,0
<:: addr integer<10>:> ,0,0,0
<:: addr real<10>:> ,0,0,0,0
<:: addr long integer<10>:> ,0
<:: addr double prec.<10>:> ,0
<:: addr complex<10>:> ,0,0,0
<:: logical array<10>:> ,0,0
<:: integer array<10>:> ,0,0
<:: real array<10>:> ,0,0,0
<:: long integer array<10>:>,0
<:: double prec. array<10>:>,0
<:: complex array<10>:> ,0,0
<:: zone array<10>:> ,0,0,0
<:: subroutine<10>:> ,0,0,0
<:: logical function<10>:> ,0
<:: integer function<10>:> ,0
<:: real function<10>:> ,0,0
<:: long integer fnc.<10>:> ,0
<:: double prec. fnc.<10>:> ,0
<:: complex function<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
f22 = f12 - f2 ;
f25 = f15 - f5 ;
\f
; fgs 1988.09.20 procsurvey, page ...18...
c7: 0 ; base buf
c27 = c7 - 2000 ;
m. rc 1988.09.20 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
d.
p.<:insertproc:>
▶EOF◀