|
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: 6912 (0x1b00)
Types: TextFile
Names: »tonline«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦this⟧ »tonline«
(
mode list.yes
(xonline=slang
xonline repeat)
scope user xonline
lookup online
mode list.no
)
;rc 19.02.73 repeat, on-line
;hcø 1978.09.01 Anders Lindgård
;the programs are translated by a slang call like:
;
; (online=slang <text>
; online repeat)
;
b. g2,f4 w. ; start insertproc block
s.w. ; start code block
d.
p.<:fpnames:>
l.
\f
; repeat, page 1
b. a10, b10
k=h55 w.
a1: 4<12 + 4 ; space,integer
a2: 1 ; left i.e. no of left par
f2: ba w3 x3 + 1 ; item:= nextitem
dl w1 x3 + 2 ; if next item
se.w0 (a1.); not integer
jl. b9. ; then error(factor)
al w1 x1 - 1 ; repetitions:=repetitions-1
rs w1 x3 + 2 ;
sh w1 0 ; if repetitions<1 then
jl. b8. ; error or last call
b1: ba w3 x3 + 1 ; rep: repeat
bl w1 x3 + 0 ; item:=nextitem
sl w1 1 ; until item=par or
jl. b1. ; item=endlist
sn w1 -4 ; if item=endlist
jl. b7. ; then error(nothing)
al w1 x1 + 1 ;
wa.w1 a2. ; left:= left + (if right_par
rs.w1 a2. ; then -1 else 1)
sl w1 1 ; if left>0 then
jl. b1. ; goto rep
am x2 + 0 ; new current command:=
al w1 x2 + 0 ; 2*current command - top address
ws w1 6 ;
sh.w1 a0. ; if new current command within this
jl. b6. ; program then error(no room)
al w3 x3 - 2 ; skip bottom delimiter
b2: al w2 x2 - 4 ; repeat
dl w1 x3 + 0 ; i:=i-4
ds w1 x2 + 2 ; newstac(i):=stac(j)
al w3 x3 - 4 ; j:=j-4
sl.w3 (h8.); until j<stactop
jl. b2. ;
al w3 x3 + 2 ; if we have moved
se.w3 (h8.); one word too much
al w2 x2 + 2 ; then i:=i+2
rs.w2 h8. ; new stacktop := i
b3: al w2 0 ;
jl.w3 h7. ; ok and end
a0: ; if the command stack should reach this point
; it will not harm this program as the rest of it
; is error procedures
\f
; repeat, page 2
; error procedures
a6: <:***repeat no core<10><0>:>
b6: al.w0 a6. ;
jl. b10. ;
a7: <:***repeat nothing to repeat<10><0>:>
b7: al.w0 a7. ;
jl. b10. ;
a8: <:***repeat factor 0<10><0>:>
b8: sn w1 0 ;
jl. b3. ; if repetitions was 1 then ok and end
al.w0 a8. ;
jl. b10. ;
a9: <:***repeat no factor<10><0>:>
b9: al.w0 a9. ;
b10:jl.w3 h31.-2 ; error ending: write errortext
al w2 1 ;
jl.w3 h7. ; ko and end
f4=k-h55
e. ; end of repeat-block
\f
;rc 26.03.73 on-line ...1...
;the program connects the current input zone to the process
;named 'terminal' in such a way that current input cannot
;be unstacked again - even not in case of fp syntax errors
;or the like i.e. primary input is also changed to the pro-
;cess 'terminal'
b. a9, b1 w.
f1: jl. w3 h29.-4 ; start: stack curr in;
al. w2 a1. ;
jl. w3 h27. ; connect(cur.in,terminal);
se w0 0 ; if not ok
jl. b1. ; then goto error;
jl. w3 h22. ; inblock(curr.in);
rl w3 x1+h3 ;
al w3 x3-2 ; record.base:=
rs w3 x1+h3 ; record.base-2;
al w3 0 ; partial.word:=0;
rs w3 x1+h2+4 ;
al. w3 a2. ; set addr for new prim.in:
jd 1<11+4 ; proc descr(terminal);
sn w0 0 ; if not found
jl. b1. ; then goto error;
rs. w0 h17.-2 ; addr(prim.in):=addr(terminal);
rs. w0 h15. ; addr(prim.out):=addr(terminal);
al w2 10 ; char:=NL;
jl. w3 h95.-2 ; closeuptext(cur.out);
jl. w3 h79. ; terminate zone
al. w2 a1. ;
jl. w3 h28. ; connect(cur.out,terminal);
se w0 0 ; if -,ok then
jl. b1. ; goto error
al. w1 a9. ; w1:=address(tail);
al. w3 a8. ; w3:=<:v:>;
jd 1<11+42 ; lookup entry(<:v:>,tail);
se w0 0 ; if -,ok then
jl. b1. ; goto error;
al. w2 a2. ;
dl w0 x2+2 ; move name
ds w0 x1+4 ;
dl w0 x2+6 ;
ds w0 x1+8 ;
al. w3 a8. ;
jd 1<11+44 ; changeentry(<:v:>,tail);
se w0 0 ; if -,ok then
jl. b1. ; goto error;
al. w3 a7. ;
jd 1<11+44 ; changeentry(<:c:>,tail);
se w0 0 ; if -,ok then
jl. b1. ; goto error
al. w3 h50. ; remove stacked zone:
jd 1<11+48 ;
ld w1 65 ; name chain:=0;
ds. w1 h50.+2
ds. w1 h50.+6 ;
al w0 1 ; set i-bit;
lo. w0 h20.+h2 ; give.up.cur.in:=
rs. w0 h20.+h2 ; give.up.cur.in or 1;
al w2 0 ; slut:
jl. h7. ; goto end program;
\f
;rc 07.12.72 on-line ...2...
b1: al. w0 a3. ; error:
jl. w3 h31.-2 ; output error text;
al w2 10 ; char:=NL;
jl. w3 h33.-2 ; outend(cur.out,char);
al. w0 a3. ;
al w2 1 ;
jl. h7. ; goto end program;
a3: <:***online connect terminal<10><0>:>
a1: 1<23+8 ; file descriptor for terminal:
a2: <:terminal:>,0 ; name
0,r.5 ; rest of tail;
a4: 1<23+8 ; file descriptor for output:
0 ;
a5: 0 ;
0 ;
a6: 0 ;
0,r.5 ;
a7: <:c:>,0,0,0
a8: <:v:>,0,0,0
a9: 0,r.10 ; tail
e.
\f
;rc 26.03.73 repeat, online
;
; insert tails into catalog
;
; the program entries are given by f1 and f2, the
; load length by f3 and f4
;
f3=k-h55
m. rc 07.02.74 online repeat
;entry on-line:
g0: (:f3+511:) > 9 ; no of segments
0,r.4 ;
s2 ; date
0,0 ; file block
2<12+f1-h55 ; contents,entry
f3 ; length
;entry repeat:
g1: 1<23+4 ; modekind = bs
0,r.4 ;
s2 ; date
0,0 ; file,block
2<12+f2-h55 ; contents,entry
f4 ; length
d.
p.<:insertproc:>
l.
e.
xonline
online
finis
▶EOF◀