|
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: 20736 (0x5100)
Types: TextFile
Names: »uti30«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦f8e4b63af⟧ »trcfput«
└─⟦this⟧
; ta 78.03.07 correct, page ...1...
s. a12,b19,c25,d6,e7,f8,g2 w.
d.
p.<:fpnames:>
l.
k=h55
b0: 0 ; cur command
b1: 0 ; program name
ds. w3 b1. ; entry:
jl. w3 h29.-4 ; stack current input
rl. w3 b0. ;
se. w3 (b1.) ; if left hand side then
jl. a1. ; alarm(call)
al w3 x3+10 ;
rs. w3 b0. ;
jl. w3 f1. ; get sep
se. w0 (c11.) ; if sep<>spacetext then
jl. a2. ; alarm(param)
jl. w3 f2. ; get param
jl. w3 f1. ; get sep
se. w0 (c12.) ; if sep<>point integer then
jl. a2. ; alarm(param)
jl. w3 f2. ; get param
rs. w0 b2. ; save segm
rl. w1 h20.+h0 ;
al w1 x1+1 ;
rs. w1 b10. ; save bufferbase+1
rl. w3 b1. ;
al w2 x3+12 ;
d6: rs. w2 b15. ; connect: save name addr;
jl. w3 h27.-2 ; connect bsfile to cur in
se w0 0 ; if not connected
jl. f6. ; then goto test compressedlib;
bl. w0 h20.+h1+1;
se w0 4 ; if kind<>4 then
jl. a3. ; alarm(not connected)
al. w1 h54. ;
al. w3 h20.+h1+2;
jd 1<11+42 ; lookup bsfile
rl. w0 h54. ;
rs. w0 b19. ; save total segm;
ws. w0 b2. ; if segm>=size-block then
ws. w0 h20.+h1+16;
sh w0 0 ; alarm(segm)
jl. a4. ;
al. w0 h20.+h1+16;
rs. w0 b16. ; save adr of segcount
rl. w0 h20.+h0 ;
ba. w0 1 ;
rs. w0 b17. ; save buffer adr.
al. w1 b13. ;
rl. w3 b15. ;
jd 1<11+42 ; lookup
rl. w0 b2. ;
am 16 ;
bl. w1 b13. ; w1:=contents-32;
al w1 x1-32 ;
sl w1 0 ; if compressed codeprocedure
wa w0 2 ; then segcount:=w1+segm;
rs. w1 b14. ;
am 17 ;
bz. w1 b13. ;
rs. w1 b15. ; save start ext list;
wa. w0 h20.+h1+16;
rs. w0 h20.+h1+16; segcount:=segcount+segm
jl. w3 h22.-2 ; inblock current in
d0: jl. w3 f1. ; nextparam:
sl. w0 (c13.) ; get sep
se w0 (0) ; if sep=end then
jl. d4. ; goto exit
se. w0 (c11.) ; if sep<>space text
jl. a2. ; then alarm(param)
al w0 0 ;
rs. w0 b4. ; firstbit:=0;
al w0 23 ;
rs. w0 b5. ; lastbit:=23;
jl. w3 f2. ; get param
se. w0 (c14.) ; if param<>real<:add:>
sn. w0 (c19.) ; and param<>real<:adr:>
se w0 (0) ; then
jl. d1. ; goto bitparam
\f
; ta 20.11.73 correct, page ...2...
jl. w3 f1. ; get sep
se. w0 (c12.) ; if sep<>pointinteger then
jl. a2. ; alarm(param)
jl. w3 f2. ; get param
ls w0 -1 ; if odd value then
ls w0 1 ; addr:=addr-1
rs. w0 b3. ; save addr
sl w0 512 ; if addr>511 then
jl. a5. ; alarm(addr)
wa. w0 b10. ; cur word addr:=
rs. w0 b11. ; bufferstart+addr
jl. d0. ; goto nextparam
d1: rl. w1 b11. ; bitparam
sn w1 0 ; if no address
jl. a2. ; then alarm(param)
se. w0 (c15.) ; if param<>real<:bit:>
jl. d3. ; then goto ifparam
jl. w3 f1. ; get sep
se. w0 (c12.) ; if sep<>pointinteger then
jl. a2. ; alarm(param)
jl. w3 f2. ; get param
rs. w0 b4. ; save firstbit
jl. w3 f1. ; get sep
se. w0 (c12.) ; if sep<>pointinteger then
jl. a2. ; alarm(param)
jl. w3 f2. ; get param
rs. w0 b5. ; save lastbit
sl w0 24 ;
jl. a9. ; if lastbit>23 then alarm(bit)
ws. w0 b4. ;
sh w0 -1 ; if lastbit>firstbit then
jl. a9. ; alarm(bit)
jl. w3 f1. ; get sep
se. w0 (c11.) ; if sep<>spacetext
jl. a2. ; then alarm(param)
jl. w3 f2. ; get param
d3: se. w0 (c16.) ; ifparam: if param<>
jl. a2. ; real<:if:> then alarm(param)
al w0 -23 ;
wa. w0 b5. ; w0:=-23+lastbit
ws. w0 b4. ; -firstbit
al w1 -1 ; w1:=all ones
ls w1 (0) ; w1:=maxnumber
rs. w1 b8. ;
jl. w3 f4. ; get value
rs. w0 b6. ; save oldvalue
se w2 0 ; if oldvalue too big
jl. a7. ; then alarm(oldvalue)
jl. w3 f1. ; get sep
se. w0 (c11.) ; if sep<>spacetext then
jl. a2. ; alarm(param)
jl. w3 f2. ; get param
se. w0 (c17.) ; if param<>real<:the:> then
jl. a2. ; alarm(param)
jl. w3 f4. ; get value
rs. w0 b7. ; save newvalue
se w2 0 ; if newvalue too big
jl. a6. ; then alarm(newvalue)
al w1 -23 ;
wa. w1 b5. ; sh:=-23+lastbit
rl. w0 (b11.) ; w0:=word
ls w0 x1 ; shift sh
la. w0 b8. ; and max
rs. w0 b8. ;
\f
; ta 76.07.19 correct, page ...3...
se. w0 (b6.) ; if oldvalue<>value in word
jl. a8. ; alarm(oldvalue)
ac w1 x1 ; sh:=23-lastbit
rl. w3 (b11.) ; w3:=word
rl. w0 b6. ;
ls w0 x1 ; w0:=oldvalue shift sh
ws w3 0 ; w3:=word-oldvalue shift sh
rl. w0 b7. ;
ls w0 x1 ; w0:=newvalue shift sh
wa w3 0 ; w3:=w3+newvalue shift sh
rs. w3 (b11.) ; store new word
jl. d0. ; goto next param
d4: rl. w1 b12. ; exit:
se w1 0 ; if wrongvalues then
jl. e4. ; then goto errorexit
al. w1 h20. ;
al w0 -1 ;
wa. w0 h20.+h1+16; segcount:=segcount-1
rs. w0 h20.+h1+16
jl. w3 h23. ; outblock
jl. w3 f7. ; changedate;
jl. w3 h30.-4 ; unstack current in
al w2 0 ; ok
d5: jl. h7. ; goto programexit
f4: ; procedure get value;
rs. w3 b9. ; begin
al w1 1 ; minus:=false
jl. w3 f1. ; get sep
sn. w0 (c13.) ; if sep=space integer then
jl. f5. ; goto not minus
se. w0 (c11.) ; if sep<>space text
jl. a2. ; alarm(param)
jl. w3 f2. ; get param
se. w0 (c18.) ; if param<>real<:neg:>
jl. a2. ; then alarm(param)
al w1 -1 ; minus:=true
jl. w3 f1. ; get sep
se. w0 (c12.) ; if sep<>pointinteger
jl. a2. ; then alarm(parm)
f5: jl. w3 f2. ; get param
al w2 0 ; error:=false
rs. w0 b18. ; save value
ws. w0 b8. ; if value-max<0
sl w0 1 ; then
al w2 1 ; error:=true;
rl. w0 b8. ;
sn w0 -1 ; if all bits
al w2 0 ; then no error
rl. w0 b18. ;
wm w0 2 ; value:=value*sign
se w2 1 ;
la. w0 b8. ; and max
jl. (b9.) ; end get value;
f1: rl. w2 b0. ; procedure get sep;
rs. w2 f3. ; begin
rl w0 x2 ; addr last sep:=cur command
al w2 x2+2 ; w0:=separator
rs. w2 b0. ; cur command:=next command
jl x3 ; end get sep;
f3: 0 ; addr. last sep
\f
; ta 76.07.19 correct, page ...4...
f2: rl. w2 b0. ; procedure get param
rl w0 x2 ; begin
al w2 x2-2 ; w0:=param
ba w2 x2+1 ; cur command:=next command
rs. w2 b0. ;
jl x3 ; end get param;
a0: 0 ; error number
a12: am 1 ; error(code inconsistent);
a11: am 1 ; error(entry inconsistent);
a10: am 1 ; error(not found);
a9: am 1 ; error(bits)
a8: am 1 ; error(oldvalue different)
a7: am 1 ; error(oldvalue)
a6: am 1 ; error(newvalue)
a5: am 1 ; error(addr)
a4: am 1 ; error(segm)
a3: am 1 ; error(not connected)
a2: am 1 ; error(param)
a1: al w0 1 ; error(call)
rs. w0 a0. ; save error number
al. w0 c0. ;
jl. w3 h31.-2 ; outtext(***)
rl. w1 b1. ;
al w0 x1+2 ;
jl. w3 h31.-2 ; outtext(programname)
rl. w0 a0. ;
sh w0 9 ; if error>9 or
sn w0 3 ; error=3 then
jl. e1. ; goto errortype1;
sl w0 5 ; if error>4 then
jl. e3. ; goto errortype3
sn w0 4 ; if error=4 then
jl. e2. ; goto errortype2
se w0 2 ;
am c20 ; if error=1 then text:=call
al. w0 c2. ; else text:=param
jl. w3 h31.-2 ; outtext(text)
rl. w0 a0. ; if error=1 then
se w0 2 ; then goto exit
jl. e4. ;
rl. w3 b0. ; if error caused by param
al w3 x3-2 ; then goto paramerror
se. w3 (f3.) ;
jl. e5. ;
al w2 32 ;
bl w3 x3 ;
sn w3 8 ; w2:=separator
al w2 46 ;
jl. w3 h26.-2 ; outtext(separator)
e5: rl. w3 f3. ; paramerror:
bl w1 x3+1 ;
sn w1 4 ; if param=integer then
jl. e6. ; goto integer param
al w0 x3+2 ; text:=param
se w1 10 ; if sep=end then
al. w0 c9. ; text:=missing
jl. w3 h31.-2 ; outtext(text)
jl. e4. ; goto errorexit
e6: rl w0 x3+2 ; integerparam:
jl. w3 h32.-2 ; outinteger(param)
1 ;
jl. e4. ; goto errorexit
\f
; ta 76.07.19 correct, page ...5...
e1: al w2 32 ; errortype1:
jl. w3 h26.-2 ; outchar(32)
rl. w1 b1. ;
al w0 x1+12 ;
jl. w3 h31.-2 ; outtext(filename)
al. w0 c3. ;
rl. w1 a0. ;
sn w1 10 ; if error=10 then
al. w0 c23. ; not found;
sn w1 11 ; if error=11 then
al. w0 c24. ; entry defect;
sn w1 12 ; if error=12 then
al. w0 c25. ; code defect;
jl. w3 h31.-2 ; outtext(not connected)
rl. w0 a0. ;
sl w0 11 ; if error>10 then
jl. w3 h30.-4 ; unstack cur in;
jl. e4. ; goto errorexit
e2: al. w0 c4. ; errortype2:
jl. w3 h31.-2 ; outtext(segm)
rl. w0 b2. ;
jl. w3 h32.-2 ; outinteger(segmno)
1 ;
jl. e4. ; goto errorexit
e3: al. w0 c5. ; errortype3:
jl. w3 h31.-2 ; outtext(addr)
rl. w0 b3. ;
jl. w3 h32.-2 ; outinteger(addr)
1 ;
rl. w0 a0. ;
sn w0 5 ; if error no=5
jl. e4. ; then goto errorexit
al. w0 c8. ;
jl. w3 h31.-2 ; outtext(bits)
rl. w0 b4. ; outinteger(firstbit)
jl. w3 h32.-2 ;
1 ;
al w2 46 ;
jl. w3 h26.-2 ; outchar(46)
rl. w0 b5. ;
jl. w3 h32.-2 ; outinteger(lastbit)
1 ;
rl. w0 a0. ; w0:=error number
sn w0 9 ; if error number=9 then
jl. e4. ; goto errorexit
sn w0 6 ; if error number=6
am c21 ; then text:=newvalue
al. w0 c7. ; else text:=oldvalue
jl. w3 h31.-2 ; outtext(text)
rl. w1 a0. ; number:=if error number=6 then
rl. w0 b7. ; newvalue
se w1 6 ; else
rl. w0 b6. ; oldvalue
jl. w3 h32.-2 ; outinteger(number)
1<23+1 ;
rl. w0 a0. ; if error<>8 then
se w0 8 ; goto errorexit
jl. e4. ; else
al. w0 c10. ;
jl. w3 h31.-2 ; outtext(, found)
rl. w0 b8. ;
jl. w3 h32.-2 ; outinteger(found oldvalue)
1<23+1 ;
rl. w1 b12. ; wrongvalues:=
al w1 x1+1 ; wrongvalues+1;
rs. w1 b12. ;
jl. d0. ; goto nextparam
e4: jl. w3 h30.-4 ; errorexit:
al w2 10 ; unstack cur input
jl. w3 h26.-2 ; outchar(10)
al w2 1 ; ok:=false
jl. d5. ; goto programexit
\f
; ta 78.03.07 correct, page ...6...
c0: <:<10>***:>
c1: <: call:>
c2: <: param :>
c3: <: not connected:>
c4: <: segm.<0>:>
c5: <: addr.<0>:>
c6: <: newvalue=:>
c7: <: oldvalue=:>
c8: <: bits.<0>:>
c9: <:missing:>
c10: <:, found=:>
c23: <: unknown<0>:>
c24: <: entry inconsistent<0>:>
c25: <: code inconsistent<0>:>
h.
c11: 4, 10 ; space text
c12: 8 , 4 ; point integer
c13: 4 , 4 ; space integer
w.
c14: <:add:>
c15: <:bit:>
c16: <:if:>
c17: <:the:>
c18: <:neg:>
c19: <:adr:>
c20=c1-c2
c21=c6-c7
c22: 12
b2: 0 ; segm
b3: 0 ; addr
b4: 0 ; firstbit
b5: 0 ; lastbit
b6: 0 ; oldvalue
b7: 0 ; newvalue
b8: 0 ; work loc., e.g. found oldvalue
b9: 0 ; workloc
b10: 0 ; buffer addr.
b11: 0 ; current word addr
b12: 0 ; wrongvalues
b13: 0 , r.10
b14: 0 ; saved proc segm
b15: 0 ; start ext list
b16: 0
b17: 0
b18: 0
b19: 0 ; total segments
\f
; ta 78.03.07 correct, page ...7...
f6: al. w1 b13. ; test compressedlib:
rl. w3 b1. ;
al w3 x3+12 ;
jd 1<11+42 ; lookup;
se w0 0 ; if not found then
jl. a10. ; alarm(unknown);
al w2 x1+2 ; w2:=docname;
jl. d6. ; goto connect;
f7: ; changedate:
b. a3 w.
rs. w3 b6. ; save return;
rl. w0 b14. ;
se w0 -28 ;
sl w0 0 ; if not procedure then
jl. a0. ; begin
al. w1 b13. ;
rl. w3 b1. ;
al w3 x3+12 ; w3:=name addr;
jd 1<11+42 ; lookup;
dl w1 110 ;
ld w1 5 ;
rs. w0 b13.+10 ; shortclock;
al. w1 b13. ;
jd 1<11+44 ; changeentry;
jl. (b6.) ; end;
a0: rl. w2 b15. ; if startext>502
sl w2 502 ; then
jl. a11. ; alarm(entry inconsistent);
al w1 0 ;
sn w0 -28 ; if not compressed then
rs. w1 b14. ; segcount:=0;
jl. w3 f8. ; get decimal time;
rs. w0 b4. ; save date;
rs. w1 b5. ; save clock;
rl. w0 b14. ;
rs. w0 (b16.) ; relsegm:=0;
jl. w3 h22.-2 ; inblock;
rl. w0 b15. ;
se w0 0 ; if startext=0
jl. a1. ; and
rl. w0 b13. ; bs
sl w0 0 ; then
jl. a1. ; begin
al. w1 b13. ; lookup docname;
al. w3 b13.+2 ; startext:=byte17
jd 1<11+42 ;
bz. w0 b13.+17 ; end;
rs. w0 b15. ;
sl w0 502 ; if startext>500 then
jl. a11. ; alarm(entry inconsistent);
a1: rl. w2 b15. ;
am. (b17.) ; basebuf;
bz w1 x2+1 ; addr:=z(startadr) extract 12
wm. w1 c22. ; *12
rs. w1 b3. ; +
am. (b17.) ;
bz w1 x2 ; z(startadr) shift (-12)
ls w1 1 ; *2
am. (b17.) ;
ba w1 x2+3 ; + own bytes
wa. w1 b3. ;
al w1 x1+6 ; +6
wa. w1 b15. ; +startext;
am. (b17.) ;
al w1 x1+0 ;
rs. w1 b3. ; b3:=clock addr;
\f
; ta 78.03.07 correct, page ...8...
a2: rl. w0 b4. ; next segm:
am. (b17.) ;
sh w1 502 ; if clockaddr<502
rs w0 x1-2 ; then save date;
rl. w0 b5. ;
am. (b17.) ;
sh w1 500 ; if clockaddr<500
rs w0 x1 ; then save clock;
al w0 0 ;
am. (b17.) ; if addr=502
sn w1 502 ; then
rs. w0 b15. ; startext:=0;
am -1000
al. w1 h20.+1000;
rl. w0 b14. ;
rs. w0 (b16.) ;
jl. w3 h23. ; outblock(0);
rl. w1 b3. ;
am. (b17.) ;
sh w1 500 ; if clockaddr<500
jl. (b6.) ; then return;
rl. w1 b19. ;
al w1 x1-1 ; seg:=seg-1;
rs. w1 b19. ;
am. (b17.) ;
bz w2 503 ; if continueaddr>500 or
sl w1 0 ; if seg<0
sl w2 500 ; then alarm(code inconsistent);
jl. a12. ;
al w1 x2-502 ; addr:=continueaddr-502
wa. w1 b3. ; + addr;
rs. w1 b3. ;
am -1000
jl. w3 h22.-2+1000; inblock(1);
rl. w1 b15. ; if startext=500 then
se w1 500 ; begin
jl. a3. ;
rl. w1 b3. ; clockaddr:=
am. (b17.) ; clockaddr
ba w1 x2+1 ; +own bytes
ws w1 4 ; -continueadr;
rs. w1 b3. ;
al w0 2 ; startext:=2;
rs. w0 b15. ; end;
a3: rl. w1 b3. ; if clockaddr>500
am. (b17.) ;
sl w1 502 ; then
jl. a2. ; goto next segm;
rl. w0 b5. ;
rs. w0 (b3.) ; save clock;
rl. w1 b3. ;
rl. w0 b4. ; if date not on
rl. w2 b15. ; first segm
se w2 0 ; then
rs w0 x1-2 ; save date;
rl. w0 b14. ;
ba. w0 1 ;
rs. w0 (b16.) ;
am -1000 ;
al. w1 h20.+1000;
am -1000
jl. w3 h23.+1000; outblock(1);
jl. (b6.) ; return;
e.
\f
; ta 76.07.19 correct, page ...9...
f8:
; get decimal time
; entry exit
; w0 - isodate
; w1 - clock
; w2 - unchanged
; w3 return destroyed
b. c11 w.
ds. w3 c11. ; save w2, w3
jd 1<11+36 ; w0w1:=get clock
nd w1 3 ; float
fd. w1 c8. ; div by 10000
bl w3 3 ;
ad w1 x3-47 ; normalize
wd. w1 c6. ; day:=sec//86400;
al w3 0 ; w0w3:=secs:=secs mod 86400;
wd. w0 c0. ; w0w3:=minutes:=secs//60;
ld w3 24 ; w2:=seconds:=secs mod 60;
wd. w0 c0. ; w0:=hour:=minutes//60;
rs. w3 c9. ; c9:=minutes:=minutes mod 60;
wm. w0 c2. ;
wa. w0 c9. ;
wm. w0 c2. ;
wa w0 4 ; c9:=clock:=(hour*100+minutes)
rs. w0 c9. ; *100+seconds;
ld w1 26 ; year:=(day*4
wa. w0 c7. ; +99111)
al w3 0 ; //1461;
wd. w0 c4. ;
as w3 -2 ; day:=day*4+99111 mod 1461//4;
wm. w3 c1. ; month:=day*5
al w3 x3+461 ; +461
wd. w3 c3. ; //153;
al w1 x2+5 ; day:=(day*5+461) mod 153 + 5;
sl w3 13 ; if month>13 then
al w3 x3+88 ; month:=month-twelvemonth+oneyear;
wm. w3 c2. ; month:=month*100;
rx w2 0 ;
wd. w1 c1. ; day:=day//5;
wa w3 2 ; date:=day+month;
wm. w2 c5. ; year:=year*10000;
wa w3 4 ; date:=date+year;
al w0 x3 ; w0:=date;
dl. w2 c10. ; w1:=clock; restore w2;
jl. w3 (c11.) ; return
c0: 60 ;
c1: 5 ;
c2: 100 ;
c3: 153 ; days in the 5 month march-july
c4: 1461 ; days in 4 years
c5: 10000 ;
c6: 86400 ; seconds in 24 hours
c7: 99111 ; to adjust for 1.1.68 being date 0
10000<9 ;
c8: 4096+14-47 ; 10000*2**(-47) as float. number
c9: 0 ; work for clock
c10: 0 ; saved w2
c11: 0 ; saved w3
e.
m.rc 1978.03.07 correct
\f
g2=k-h55
g0:g1: (:g2+511:)>9 ; segm
0, r.4 ; doc
s2 ; date
0,0 ; fil, block
2<12+4 ; contents.entry
g2 ; loadlength
d.
p.<:insertproc:>
e.
m. rc 20.11.73, correct
e.
\f
▶EOF◀