|
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: 4608 (0x1200)
Types: TextFile
Names: »tdiags«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦09b4e9619⟧ »thcømat«
└─⟦this⟧
(clear diag
diag=set 1
if 15.no
(diag=slangx entry.no
diag)
if 15.yes
(diag=slangx entry.no list.yes
diag)
permanent diag.5)
b. h99 ;
p. <:fpnamesx:> ;
b. g1, e2 ;
k=0 ;
s. g2, j42, b20 ;
h. ;
g0=0 ;
e2: ;
g1: g2 , g2 ;
j1: g0+ 1, 0 ; **real
j3: g0+ 3, 0 ; reserve
j4: g0+ 4, 0 ; take expression
j6: g0+ 6, 0 ; end register expression
j13: g0+13, 0 ; last used
j18: g0+18, 0 ; zone alarm
j29: g0+29, 0 ; param alarm
j30: g0+30, 0 ; saved stack ref, saved w3
g2=-g1.-2 ;
w. ;
e0: g0 ;
0 ;
0, 0 ;
p. <:version:> ;
; integer procedure take positive parameter;
; 4 bytes must have been reserved in stack before entry.
; call return
; w0: ?
; w1: formal1addr parameter
; w2: stackref stackref
; w3: link ?
; the parameter is also stored in formal1.
b. a5, w. ; begin
b0: rs w1 x2-2 ; save formal1addr;
al. w0 a1. ;
ws w3 0 ; catculate return;
rs w3 x2-4 ; save link;
dl w1 x1+2 ; take formals;
sz w0 16 ; if expression then
jl. a0. ; begin
jl. w3 ( j4.) ; take expression;
ds. w3 ( j30.) ; save stack reference
; end;
a0: dl w1 x1 ; take value;
rl w3 (x2-2) ; w3:= formal1;
sz w3 1 ; if real
cf w1 0 ; then round;
sh w1 0 ; if not positive
jl. w3 ( j29.) ; then param alarm;
rs w1 (x2-2) ; save param in formal1;
am (x2-4) ;
a1: jl. 0 ; return
e. ; end;
; procedure take real array and check index;
; 4 bytes must have been reserved in stack before entry.
; call return
; w0: formal1addr ?
; w1: index index
; w2: stackref stackref
; w3: link ?
; the address of the first element is stored in formal1.
b. a5, w. ; begin
b1: rx w1 0 ;
ds w0 x2-2 ; save index; save link;
rl w3 x1+2 ;
ba w3 x1 ; w3:= absolute dope address;
al w0 4 ;
wa w0 x3 ; w0:= lower index;
wa w0 (x1+2) ; w0:= address of first element;
rs w0 x1 ; formal1:= w0;
rl w0 x3-2 ; w0:= (upper index
ws w0 x3 ; -lower index+4)
as w0 -2 ; //4;
rl w1 x2-2 ; w1:= index;
sl w0 x1 ; if subscriptrange+1 >= index
jl (x2-4) ; then return
jl. w3 ( j18.) ; else index alarm
e. ; end;
; real procedure multiply accumulating;
; performs the calculation
; s:= s+m1*m2;
;
; call return
; w0: s-addr
; w1: m1-addr result
; w2: m2-addr m2-addr
; w3: link link
b. d0, w. ; begin
d0: 0 ;
b2: rs. w0 d0. ;
dl w1 x1 ;
fm w1 x2 ;
fa. w1 ( d0.) ;
ds. w1 ( d0.) ;
jl x3 ;
e. ; end;
b. a30,f10,g10,w. ; begin
g0: 0 ; integer i;
g1: 0 ; integer j;
g2: 0 ; integer k;
g3: 0 ; integer l;
g4: 0 ; integer m;
f.
f0: 0 ; real f;
f1: 0 ; real g;
f2: 0 ; real h;
f3: 0 ; real hh;
f4: 0 ; real b;
f5: 0 ; real c;
f6: 0 ; real p;
f7: 0 ; real r;
f8: 0 ; real s;
w.
e.
....
rl w0 >n< ;
rs. w0 g0. ; for i:= n step -1 until 2 do
sh w0 1 ;
jl. zz ;
▶EOF◀