|
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: 13056 (0x3300)
Types: TextFile
Names: »wrdaterctx«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦80900d603⟧ »giprocfile«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦80900d603⟧ »giprocfile«
└─⟦this⟧
; rc 1977.11.28 writedate page ...1...
; write_date_rc
; *************
(
write_date_rc = set 1
write_date_rc = slang entry.no
write_date_rc
if ok.no
(mode 0.yes
message write_date_rc not ok
lookup write_date_rc)
)
;contents:
;label, page, name
;d5 2 initiate parameters of proc
;d6 7 write into zone
; 8 tail part
b.w.
d.p.<:fpnames:>,l.
b. e7, g1 w. ; block with names for tail
s. a5,b9,c7,f5,d0,g2,i20,j40 ; slang segment for procedure
k=10000
i2=2,i4=4,i6=6,i8=8,i10=10,i12=12,i14=14,i16=16,i18=18,i20=20
h.
g0=0
e0: g2 , g1 ; rel of point ,rel of abs word
; abs words:
j3: g0+3 , 0 ; rs entry 3, reserve
j4: g0+4 , 0 ; 4, take expression
j6: g0+6 , 0 ; 6, end register expression
j13: g0+13 , 0 ; 13, last used
j21: g0+21 , 0 ; 21, general alarm
j30: g0+30 , 0 ; 30, saved stack rel, saved w3
g1=k-2-e0 ; end abs words
;points:
j35: g0+35 , 0 ; rs entry 35, outblock
g2=k-2-e0 ; end rel words
w. ; start of external list
e1: 0 ; no externals
0 ; no owns
s3 ; date
s4 ; time
; constants and texts
b0: 10 ;
b1: 100 ;
b2: 100000 ;
b3: 0 ; store addr
b4: 0 ; saved stack ref
0 ;
b5: 0 ; current number;
b6: <:<10>z. state:> ; alarm text
b7: 255 ; bit(16:23)=ones
b8: 255<16 ; bit(0:7)=ones
b9: 0 ; format;
\f
; rc 1977.11.28 writedate page ...2...
; procedure writedate(z,date,sec,format);
; zone z; value date, sec, format; integer date,sec,format;
;initiate first two parameters of proc(zone,integer,...)
;saves the stack reference and checks the validity of the
;formal parameters for the zone. partial word addr and
;record base addr are stored in the words +i6 and +i8
;of the stack, respectively. the integer parameter is
;evaluated both as an integer and as a result addr.
; entry: exit:
;w0: integer mod 2**24
;w1: result addr.integer
;w2: stack
;w3:
;stack
;-i2: stack ref
;+i6: zone format, param partial word addr
;+i8: record base addr
;+i10:date date
;+i12: sec
e2: ; entry:
rl. w2 (j13.) ; zone parameter:
ds. w3 (j30.) ; saved stack ref:= w2:= last used;
rl w3 x2+i8 ; zone descr:= zone formal 2;
rl w1 x3+h2+6 ; state:= zone state.zone descr;
se w1 3 ;
sn w1 0 ; if state<>after write
jl. a0. ; and state<>after open
; then
al. w0 b6. ; general alarm(state,alarm text);
jl. w3 (j21.) ;
a0: sn w1 0 ; if state = after open
rs w1 x3+h3+4 ; then record length:= 0;
al w1 3 ;
rs w1 x3+h2+6 ; state:= after write;
al w0 x3+h2+4 ; partial word addr:= zone descr+h2+4;
al w1 x3+h3 ; record base addr:= zone descr+h3;
ds w1 x2+i8 ;
al w1 -24 ; reserve 24 bytes
jl. w3 (j3.) ; in stack;
rl. w3 (j30.) ;
rs w3 x2-i2 ;
\f
; rc 1977.11.28 writedate page ...3...
dl w1 x2+i12 ; w1:=formal2(date);
so w0 16 ; if expression then
jl. w3 (j4.) ; take expression;
ds. w3 (j30.) ; save stack ref;
dl w1 x1 ; w0.w1:=date;
rl w3 x2+i10 ; if type=real
sz w3 1 ; then
cf w1 0 ; convert to integer;
rs w1 x2+i10 ; stack(10):=date;
dl w1 x2+i16 ; w1:=formal2(sec);
so w0 16 ; if expression
jl. w3 (j4.) ; take expression;
ds. w3 (j30.) ; save stack ref;
dl w1 x1 ; w0.w1:=sec;
rl w3 x2+i14 ; if type=real
sz w3 1 ; then
cf w1 0 ; convert to integer;
rs w1 x2+i12 ; stack(12):=sec;
dl w1 x2+i20 ; w1:=formal2(format);
so w0 16 ; if expression then
jl. w3 (j4.) ; take expression;
ds. w3 (j30.) ; save stack ref;
dl w1 x1 ; w0.w1:=format;
rl w3 x2+i18 ; if type=real
sz w3 1 ; then
cf w1 0 ; convert to integer;
rs. w1 b9. ; save format;
; end;
; format output
; 1 minutes
; 2 seconds
; 4 19 in front of year
; 8 <:d.:>
; 16 day month year
; 32 trailing sp
; 64 leading sp
;4096 input is day month year
\f
; rc 1977.11.28 writedate page ...4...
a1: rl. w0 b9. ;
ls w0 23-3 ; set format8
ls w0 -23 ;
hs. w0 f0. ;
hs. w0 f1. ;
hs. w0 f2. ;
hs. w0 f3. ;
hs. w0 f4. ;
hs. w0 f5. ;
rs. w2 b4. ; save stack ref;
al w1 x2-24 ;
rs. w1 b3. ; save store addr.
rl w1 x2+i10 ;
rs. w1 b5. ; save current number;
rl. w1 b9. ;
sz w1 64 ; if format64 then
jl. w3 c4. ; store(sp);
f0=k+1
sn w1 x1+0 ; if format8 then
jl. 6 ; begin
jl. w3 c3. ; store(d); store(.);
jl. w3 c5. ; end;
rl. w1 b9. ;
sz w1 4 ;
sz w1 16 ; if format4 and-,format16 then
jl. 6 ; begin
jl. w3 c1. ; store(1); store(9);
jl. w3 c2. ; end;
rl. w1 b9. ; if format16
ls w1 23-4 ; <> first part of format
ls w1 -23 ; i.e. input<>output
bl. w0 b9. ; then
sn w0 x1 ;
jl. a2. ;
dl. w3 b5. ; switch day and year;
wd. w3 b1. ;
wm. w2 b1. ;
rx w2 6 ;
wd. w2 b1. ;
wa w1 6 ;
wm. w1 b1. ;
wa w1 4 ;
rs. w1 b5. ;
a2: jl. w3 c6. ; store(digit);
jl. w3 c6. ; store(digit);
f1=k+1
sn w1 x1+0 ; if -,format8 then
jl. w3 c5. ; store(point);
jl. w3 c6. ; store(digit);
jl. w3 c6. ; store(digit);
f2=k+1
sn w1 x1+0 ; if -,format8 then
jl. w3 c5. ; store(point);
rl. w1 b9. ;
sz w1 4 ; if format4 and
so w1 16 ; format16 then
jl. 6 ; begin
jl. w3 c1. ; store(1); store(9);
jl. w3 c2. ; end;
\f
; rc 1977.11.28 writedate page ...5...
jl. w3 c6. ; store(digit);
jl. w3 c6. ; store(digit);
rl. w1 b9. ;
ls w1 22 ;
sn w1 0 ; if format1 then
jl. a3. ; begin
rl. w2 b4. ;
rl w1 x2+i12 ; number:=seconds;
rs. w1 b5. ;
al w2 32 ;
f3=k+1
se w1 x1+0 ; store(if format8 then
al w2 46 ; point else space);
jl. w3 c7. ;
jl. w3 c6. ; store(digit);
jl. w3 c6. ; store(digit);
f4=k+1
sn w1 x1+0 ; if -,format8 then
jl. w3 c5. ; store(point);
jl. w3 c6. ; store(digit);
jl. w3 c6. ; store(digit);
rl. w1 b9. ;
so w1 2 ; if format2 then
jl. a3. ; begin
f5=k+1
sn w1 x1+0 ; if -,format8 then
jl. w3 c5. ; store(point);
jl. w3 c6. ; store(digit);
jl. w3 c6. ; store(nextdigit);
; end format2;
; end format1;
a3: rl. w1 b9. ;
sz w1 32 ; if format32 then
jl. w3 c4. ; store(sp);
al w2 0 ;
jl. w3 c7. ; store(0);
rl. w2 b4. ;
al w1 x2-25 ; start print;
rl. w3 b3. ;
ws w3 2 ;
al w3 x3-2 ;
rs w3 x2+12 ; save positions
;move stack buf and finish:
;moves the contents of the stack buffer into the zone
;and releases the stack buffer.
a4: al w1 x1+1 ; move stack: print:=print+1;
bz w0 x1 ; next char;
sn w0 0 ; if char=0 then
jl. a5. ; goto finish;
jl. w3 d0. ; write into zone(stack buffer(print));
jl. a4. ; goto move stack;
; finish:
a5: rs. w2 (j13.) ; last used:= stack ref:
rl w1 x2+12 ; positions;
jl. (j6.) ; end register expression;
\f
; rc 1977.11.28 writedate page ...6...
c1: am 1-9 ; store(1);
c2: am 48+9-100; store(9);
c3: am 100-32 ; store(d);
c4: am 32-46 ; store(sp);
c5: al w2 46 ; store(.);
jl. c7. ;
c6: dl. w1 b5. ; get number;
wd. w1 b2. ; next digit;
al w2 x1+48 ; char;
al w1 (0) ;
wm. w1 b0. ; number:=number*10;
rs. w1 b5. ;
c7: hs. w2 (b3.) ; store
rl. w1 b3. ;
al w1 x1+1 ; storeadr:=storeadr+1;
rs. w1 b3. ;
jl x3 ; return
\f
; 1977.11.28 writedate page ...7...
;procedure write into zone(char);
;outputs the right-most 8 bits of the character to the zone
;buffer. the block is changed if necessary.
; entry: exit:
;w0: char destroyed
;w1: uchanged
;w2: stack ref stack ref
;w3: link destroyed
;stack
; +i6: partial word addr partial word addr
; +i8: record base addr record base addr
;+i10: destroyed
b.a1 w.
d0: la. w0 b7. ; begin
rs w1 x2+i10 ;
rl w1 (x2+i6) ; char:= char(16:23);
sz. w1 (b8.) ; if partial word not full then
jl. a0. ; begin
ls w1 8 ; partial word:= partial word
lo w1 0 ; shift 8 or char;
rs w1 (x2+i6) ; return;
rl w1 x2+i10 ;
jl x3 ; end;
a0: ls w1 8 ; next word:
lo w0 2 ; partial word:= partial word
rl w1 (x2+i8) ; shift 8 or char;
al w1 x1+2 ; record base:= record base+2;
rs w1 (x2+i8) ; zone buf(record base):=
rs w0 x1 ; partial word;
al w0 1 ; partial word:= empty:= 1;
rs w0 (x2+i6) ;
am (x2+i8) ; if record base < last byte
sl w1 (2) ; then return;
jl. a1. ;
rl w1 x2+i10 ;
jl x3 ;
a1: al. w0 e0. ; change block:
ws w3 0 ; rel:= link-segment start;
rs w3 x2-i2 ;
rl w0 x2+i8 ;
ls w0 4 ; w0:= zone descr addr shift 4;
rl. w1 j35. ; w1:= outblock entry point;
jl. w3 (j4.) ; take expression;
ds. w3 (j30.) ; saved stack ref:= w2;
rl w1 x2+i10 ;
am (x2-i2 ) ; link:= segment start+rel;
jl. e0. ; return (link);
e. ; end write into zone;
\f
;rc 1977.11.28 writedate page ...8...
e7:
c. e7-e0-506
m. code on segment 1 too long
z.
c. 502-e7+e0, -1,r. 252-(:e7-e0:)>1
; fill the rest of the segment with -1
z.
<:writedate:> ; alarm text
e. ; end slang segment
m. rc 1977.11.28 writedate
; tail part
; writedate:
g0:g1:
1 ; area entry with 1 segment
0,0,0,0 ; fill for name
1<23+e2-e0 ; entry point
3<18+13<12+13<6+13; integer proc(integer,integer,integer,
8<18 ; zone)
4<12+e1-e0 ; code proc, ext list
1<12+0 ; code segm, own bytes
d.p.<:insertproc:>
e.
▶EOF◀