|
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: 21504 (0x5400)
Types: TextFile
Names: »translat4tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »translat4tx «
; fgs 1988.09.16 translated page ...1...
;b. ; dummy outer block for fpnames;
d.
p.<:fpnames:>
l.
b. g3 ; block for insertproc;
w.
d.
p.<:fpnames:>
l.
k=h55
s. a30, b30, c30, d30, e30
w.
; a-names: alarm
; b-names. labels in program
; c-names: texts for alarm
; d-names: constants and texts
; e-names: work loc
e0 : 0 ; addr of sep in front of next param
e1 : 0 ; addr of sep in front of program name
e2 : 0 ; error text addr
e3 : 0 ; addr compiler name
e4 : 0 ; addr of date
e5 : 0 ; work loc
e6 : 0 ; work loc
e7 : 0, r.10 ; lookup area no. 1
e8 : 0, r.10 ; lookup area no. 2
e9 : 0, 0 ; saved shortclock
e10: 0, r.4 ; saved name
e11: 0 ; spec. out zone
\f
; fgs 1988.10.04 translated page ...2...
g3: jl. w1 b20. ; init program;
jl. w3 b28. ; if left side then connect output;
b7: rs. w1 e11. ; 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+h0 ; first of buffer-1;
al w3 x3+512 ; last buf(cur prog zone):=
rs w3 x1+h0+2; base buf+512;
b0: al. w1 h19. ; paramloop:
jl. w3 h79. ; terminate cur prog zone;
rl. w1 e0. ;
bl w2 x1 ;
sh w2 3 ; if endparam then
jl. b4. ; goto exit;
bl w2 x1+1 ;
wa w1 4 ;
rs. w1 e0. ; update param pointer;
se w2 10 ; if param<>text then
jl. a2. ; alarm (param);
rl. w3 e0. ;
al. w1 e7. ;
al w3 x3-8 ;
jd 1<11+42; lookup param;
se w0 0 ; if not found then
jl. a4. ; alarm (unknown);
rl. w1 e7. ; lookup area no. 2.size :=
rs. w1 e8. ; entry.size;
bl. w1 e7.+16 ;
sl w1 2 ; if entry.contents < 2
sl w1 4 ; or entry.contents > 3 then
jl. a5. ; alarm (not program);
\f
; fgs 1988.09.16 translated page ...3...
rl. w1 e7. ;
sl w1 0 ; if entry.size < 0 then
jl. a7. ; begin <*bs entry*>
al. w1 e8. ;
al. w3 e7.+2 ;
jd 1<11+42; lookup (entry.docname, lookup area no. 2);
se w0 0 ; if not found then
jl. a4. ; alarm (not found);
a7: rl. w1 e0. ; end <*bs entry*>;
al w2 x1-8 ;
al. w1 h19. ; zone := spec. out zone;
jl. w3 h27. ; connect (curr prog, entry);
se w0 0 ; if not connected then
jl. a3. ; alarm (error);
zl. w1 e7.+17 ;
se w1 0 ; if entry.entry point = 0 then
jl. a8. ; begin <*pascal*>
al. w0 d9. ; compiler addr :=
rs. w0 e3. ; addr <:pascal:>;
rl. w0 e7.+18 ; rel addr := entry.load length;
sl w0 4 ; if rel addr < 4
sl w0 510 ; or rel addr > 510 then
jl. b10. ; goto take shortclock;
rl. w2 h19.+h0; addr first :=
al w2 x2+6 ; addr first + 6;
jl. a11. ; goto print;
; end <*pascal*> else
a8: rl. w1 e7.+12 ;
se w1 0 ; if entry.file count = 0 then
jl. a9. ; begin <*slang*>
al. w0 d8. ; addr compiler name :=
rs. w0 e3. ; addr <:slang:>;
jl. a11. ; goto print;
; end <*slang*>;
a9: zl. w0 e7.+13 ; rel addr := entry.word7.rel;
el. w1 e7.+12 ; segm := entry.word7.segm;
\f
; fgs 1988.09.16 translated page ...4...
sl w1 6 ; if segm >= 6 and
sl w1 12 ; segm < 12 then
jl. a12. ; begin <*program descriptor vector*>
wa. w1 e7.+14 ; curr prog.segm count :=
am. h19. ; segm +
rs w1 h1+16 ; entry.block count ;
al. w1 h19. ; zone := spec. out zone;
jl. w3 h22. ; inblock;
rl. w2 h19.+h0; addr first := curr prog.base buffer area;
am (0) ; modeword2 :=
rl w1 x2+3 ; prog descriptor vector.modeword2;
ls w1 -5 ; addr compiler :=
al. w3 d7. ; if modeword shift (-5) = 1 then
sz w1 1 ; addr <:fortran:>
al. w3 d6. ; else
rs. w3 e3. ; addr <:algol:>;
am (0) ; segm :=
zl w1 x2+19 ; prog descr vect.entry point.segm;
am (0) ; rel addr :=
zl w0 x2+20 ; prog descr vect.entry point.rel ;
sl w1 12 ; if segm < 12
sl. w1 (e8.) ; or segm >= lookup area no. 2.size then
jl. b10. ; goto take shortclock;
jl. a10. ; goto print0;
; end <*program descriptor vector*>;
a12: sh w1 11 ; if segm >= 12 then
jl. a13. ; begin <*entry point to main program*>
sl. w1 (e8.) ; if segm >= lookup area no. 2.size then
jl. b10. ; goto take shortclock;
al. w3 d12. ; addr compiler :=
rs. w3 e3. ; addr <:algol/fortran:>;
rl. w2 h19.+h0; addr.first := curr prog.base buffer area;
jl. a10. ; goto print0;
; end <*entry point to main program*>;
\f
; fgs 1988.09.16 translated page ...5...
a13: al. w1 h19. ; <*search program entry point in rts segment 0*>
jl. w3 h22. ; inblock (curr prog, segm 0);
rl. w2 h19.+h0; addr first := curr prog.base buffer area;
rl w1 x2+1 ; first := (addr first);
se w1 4 ; if first = 4
sn w1 0 ; or first = 0 then
jl. b6. ; goto ok
jl. a5. ; else
; alarm (not program);
;
b6: al. w1 d12. ; ok:
rs. w1 e3. ; addr compiler := addr <:algol/fortran:>;
al w1 -1 ;
b1: al w1 x1+2 ; loop: if(0,-8388698,511) not found
sl w1 451 ; among words (0:450) then
jl. b10. ; goto take shortclock;
am x2 ; word :=
rl w3 x1 ; cont (first);
se w3 0 ; if word<>0 then
jl. b1. ; goto loop;
am x2 ; word :=
rl w3 x1+2 ; cont (first + 2);
se. w3 (d1.) ; if word<>-8388608 then
jl. b1. ; goto loop;
am x2 ; word :=
rl w3 x1+4 ; cont (first + 4);
se w3 511 ; if word<>511 then
jl. b1. ; goto loop;
am x1 ; addr nextword :=
al w3 x2+6 ; addr of next word;
rl w1 x3 ; nextword := cont (addr nextword);
al. w0 d7. ; addr compiler := addr <:algol:>;
sn w1 0 ; if nextword = 0 then
al. w0 d6. ; addr compiler := addr <:fortran:>;
rs. w0 e3. ; save addr compiler;
sn w1 0 ; if nextword = 0 then
al w3 x3+12 ; addr nextword := addr nextword + 12 (fortran);
bl w1 x3 ; rel segm := nextword.segm;
bl w0 x3+1 ; rel addr := nextword.addr;
\f
; fgs 1988.09.16 translated page ...6...
rl. w3 e3. ;
se w1 0 ; if rel segm = 0
sn w0 0 ; or rel addr = 0 then
al. w3 d12. ; addr compiler := addr <:algol/fortran:>;
rs. w3 e3. ;
sl w1 6 ; if rel segm < 6
sl. w1 (e8.) ; or rel segm > lookup area no. 2.size then
jl. b10. ; goto take shortclock;
a10: sl w0 4 ; if rel addr < 4
sl w0 510 ; or rel addr > 510 then
jl. b10. ; goto take shortclock;
a11: wa. w1 e7.+14 ; curr prog.segm count :=
am. h19. ; rel segm +
rs w1 h1+16 ; entry.block count ;
al. w1 h19. ; zone := curr prog zone;
jl. w3 h22. ; inblock (curr prog);
am (0) ; addr of date :=
al w1 x2-3 ; addr of first +
rs. w1 e4. ; rel addr -3;
rl. w1 e3. ;
sn. w1 d8. ; if slang then
jl. w3 b11. ; get shortclock;
rl. w0 (e4.) ;
sh w0 0 ; if date <= 0 then
jl. w3 b11. ; get shortclock;
\f
; fgs 1988.09.16 translated page ...7...
a14: rl. w1 e0. ; print:
dl w0 x1-6 ; move name
lo. w3 d10. ; from parameter
lo. w0 d10. ; to saved name
ds. w0 e10.+2 ; and
dl w0 x1-2 ; extend
lo. w3 d10. ; with spaces
lo. w0 d11. ; to 12 positions;
ds. w0 e10.+6 ;
al. w0 e10. ;
rl. w1 e11. ; zone := spec. out zone;
jl. w3 h31. ; outtext (saved name);
al. w0 d5. ;
jl. w3 h31. ; outtext (translated by);
rl. w0 e3. ;
jl. w3 h31. ; outtext ((addr compiler));
rl. w0 (e4.) ;
sh. w0 (d14.) ; if date > 991231
sh. w0 (d13.) ; or date <= 750100 then
jl. w3 b11. ; goto take shortclock;
al. w1 d4. ;
al w2 46 ;
jl. w3 b2. ; print(dd.);
al. w1 d3. ;
al w2 46 ;
jl. w3 b2. ; print(mm.);
al. w1 d2. ;
al w2 32 ;
jl. w3 b2. ; print(yy );
rl. w1 e4. ;
rl w0 x1+2 ;
rl. w1 e3. ;
sn. w1 d9. ; if pascal then
jl. b3. ; goto printnl;
al. w1 d4. ;
al w2 46 ;
jl. w3 b2. ; print(hours.);
al. w1 d3. ;
al w2 10 ;
jl. w3 b2. ; print(min<10>);
jl. b0. ; goto paramloop
\f
; fgs 1988.09.16 translated page ...8...
b2: rs. w3 e6. ; procedure print
al w3 0 ;
wd w0 x1 ;
rs. w3 e5. ;
rl. w1 e11. ; zone := spec. out zone;
jl. w3 h32. ;
48<12+2 ;
jl. w3 h26. ;
rl. w0 e5. ;
jl. (e6.) ;
b3: al w2 10 ; printnl:
rl. w1 e11. ; zone := spec. out zone;
jl. w3 h26. ; outchar (zone, 'nl');
jl. b0. ; goto paramloop;
b4: rl. w1 e11. ; exit:
se w1 0 ; if no sec zone
sn. w1 h21. ; or zone = cur out then
jl. b8. ; 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. b9. ; 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*>;
\f
; fgs 1988.09.16 translated page ...9...
b9: rl. w3 h8. ; <*set contents*>
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);
b8: ; end <*terminate sec. out*>
rl. w1 d0. ;
al w2 0 ;
se w1 0 ;
al w2 1 ; if errors then ok no
am -2000;
jl. h7.+2000; goto fp;
b10: jl. w3 b11. ; take shortclock:
jl. a14. ; get shortclock and goto print;
b. b0 ; begin block get shortclock;
w.
b11: rs. w3 b0. ;get shortclock: save return;
rl. w0 e7.+10 ; shortclock := entry.shortclock;
jl. w3 b12. ; convert clock (shortclock);
rs. w0 e9. ; save converted date;
rs. w3 e9.+2 ; save converted clock;
al. w3 e9. ; addr of date :=
rs. w3 e4. ; addr converted shortclock;
jl. (b0.) ; return;
b0: 0 ; saved return
e. ; end block get shortclock;
\f
; fgs 1988.09.16 translated page ...10...
; procedure convert clock (short clock)
;
; (taken from lookup)
;
; this procedure is an inversion of the following algorithm
; for computing day-number from a date (year,month,date)
; extended with a conversion of the time of the day:
;
;
; if month<3 then
; begin
; month:=month+12;
; year:=year-1;
; end;
; dayno:=(1461*year)//4 + (153*month+3)//5 + day;
;
;
;
; call: return:
;
; w0 short clock year*10000+month *100+date
; w1 irrelevant destroyed
; w2 irrelevant destroyed
; w3 return hour*10000+minute*100
;
;
;
b. a13, b0 w. ; begin block convert clock
b12: ld w2 -100 ; clear w1,w2;
rs. w3 a8. ; save return address;
al w3 0 ; clear w3;
ld w0 10 ; w3,w0:=short clock<10 (=truncated clock>9);
wd. w0 a2. ; w0:=dayno;
al w3 x3+a13 ; add minute rounding;
wd. w3 a1. ; w3:=hour;
wd. w2 a0. ; w2:=minute;
ds. w3 a10.; save minute,hour;
\f
; fgs 1988.09.16 translated page ...11...
al w3 0 ; clear w3;
ld w2 -100 ; clear w1,w2;
ls w0 2 ; w0:=dayno*4;
wa. w0 a5. ; add offset;
wd. w0 a4. ; w0:=year;
ls w3 -2 ; w3 is converted ;
wm. w3 a6. ; to fifthdays;
al w3 x3+a11 ; w3:=w3+three months offset;
wd. w3 a3. ; w3:=month;
sh w3 12 ; if month>12 then
jl. b0. ; begin
ba. w0 1 ; increase year;
al w3 x3-12 ; decrease month
b0: al w2 x2+a12 ; end;
wd. w2 a6. ; w2:=date;
rs w3 2 ; save month (in w1);
wm. w0 a7. ; w0:=year*100
wa w0 2 ; + month
wm. w0 a7. ; * 100
wa w0 4 ; + date;
rl. w3 a10.; w3:=hour
wm. w3 a7. ; * 100
wa. w3 a9. ; + minute
wm. w3 a7. ; * 100;
jl. (a8.); return;
a0: 1172 ; units per minute
a1: 70313 ; units per hour
a2: 1687500 ; units per day
a3: 153 ; days in the five months (march-july)
a4: 1461 ; days in four years
a5: 99111 ; offset for computing year
a6: 5 ;
a7: 100 ; constant for packing date and time
a8: 0 ; saved return address
a9: 0 ; saved minute
a10: 0 ; saved hour
a11=461 ; three months offset
a12=5 ; one days offset
a13=586 ; half a minute
e. ; end block convert clock;
\f
; fgs 1988.09.16 translated page ...12...
c0: <:***<0>:>
c1: <: connect:>
c2: <: param <0>:>
c3: <: connect<10><0>:>
c4: <: unknown<10><0>:>
c5: <: not program<10><0>:>
c6: <: date not found<10><0>:>
a1: am c1-c2 ; alarm (connect);
a2: am c2-c3 ; alarm (param);
a3: am c3-c4 ; alarm (connect);
a4: am c4-c5 ; alarm (unknown);
a5: am c5-c6 ; alarm (not program);
a6: al. w0 c6. ; alarm (date not found);
rs. w0 e2. ; save alarm cause
al. w0 c0. ;
jl. w3 h31.-2 ; outtext (***);
rl. w3 e1. ;
al w0 x3+2 ;
jl. w3 h31.-2 ; outtext (programname);
rl. w1 e2. ;
sh. w1 c2. ; if not connect out and
jl. b5. ; if not param then
al w2 32 ;
jl. w3 h26.-2 ; outsp;
rl. w1 e2. ;
b5: se. w1 c1. ; if connect out alarm then
jl. b13. ; begin
am -2000;
rl. w3 h8.+2000;
al w0 x3+2 ;
jl. w3 h31.-2 ; outtext (out, outfile.name);
jl. b15. ; end else
b13: sn. w1 c2. ; if not param alarm then
jl. b15. ; begin
rl. w3 e0. ;
al w0 x3-8 ; outtext (param);
jl. w3 h31.-2 ; end;
\f
; fgs 1988.09.16 translated page ...13...
b15: rl. w0 e2. ;
jl. w3 h31.-2 ; outtext (error cause);
rl. w2 d0. ;
al w2 x2+1 ; errors:=errors+1;
rs. w2 d0. ;
rl. w0 e2. ;
sn. w0 c2. ; if not param alarm then
jl. b14. ; begin
al w2 10 ; outcr;
jl. w3 h26.-2 ;
rl. w0 e2. ; end;
b14: sn. w0 c1. ; if connect output error then
jl. b7. ; goto continue; <*w1 = curr. out zone*>
se. w0 c2. ; if not param alarm then
jl. b0. ; goto paramloop;
rl. w1 e0. ;
rl w0 x1-2 ;
jl. w3 h32.-2 ; outinteger (param);
1 ;
al w2 10 ;
jl. w3 h26.-2 ; outcr;
jl. b0. ; goto paramloop;
\f
; fgs 1988.09.16 translated page ...14...
;procedure init program
;
;called just after entry nb: link w1
;
b20: ds. w3 e1. ; save stack pointers;
al w2 x3+10 ; addr next param :=
rs. w2 e0. ; addr program name + 10;
bz w2 x3 ;
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;
;connect special output zone
;
b. j4 ;
w.
j0: 0 ; save return
b28: rs. w3 j0. ;
jl. w3 h29.-4 ; stack curr in;
rl. w2 e1. ;
al w2 x2-8 ; w2:=addr(outfile name);
al w0 1<2+0 ;
jl. w3 h28. ; connect cur in (outfile);
se w0 0 ; if troubles then
jl. a1. ; goto connect output alarm;
bl w0 x1+h1+1;
se w0 4 ; if not bs and
sn w0 18 ; not mt then
jl. b29. ; return;
jl. (j0.) ;
b29: al. w1 h54. ; w1:=lookup area;
rl. w2 e1. ;
al w2 x2-8 ;
jl. w3 b30. ; prepare output
am -2000;
al.w1 h20.+2000; w1:=cur in
jl. (j0.) ; return; comment: now w1
; points to cur out zone;
e. ; end of connect second out
\f
; fgs 1988.09.16 translated page ...15...
; procedure prepare entry for textoutput
; w0 not used
; w1 lookup area
; w2 name addr, entry must be present
; w3 return addr
b. a2 w.
b30: 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.16 translated page ...16...
d0 : 0 ; errors
d1 : -8388608 ;
d2 : 1 ;
d3 : 100 ;
d4 : 10000 ;
d5 : <: translated by <0>:>
d6 : <: fortran <0>:>
d7 : <: algol <0>:>
d8 : <: slang <0>:>
d9 : <: pascal <0>:>
d10: <:<32><32><32>:>
d11: <:<32><32><00>:>
d12: <: algol/fortran <0>:>
d13: 750100
d14: 991231
g2=k-h55
c17: 0 ; start buffer program zone
c27 = c17 - 2000 ;
m.translated 1988.10.04
e.
g0:g1: (:g2+511:)>9 ; segm
0, r.4 ; doc
s2 ; date
0, 0 ; file, block
2<12+(:g3-h55:); contents.entry
g2 ; loadlength
d.
p.<:insertproc:>
▶EOF◀