|
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: 6144 (0x1800)
Types: TextFile
Names: »uti4«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦f8e4b63af⟧ »trcfput«
└─⟦this⟧
;rc 28.03.1973 insertproc
;inserts intries into catalog
;the name parts are taken as parameters from the file
;processor command stack and the tail parts from the just
;assembled slang code where
; g0= start of first tail
; g1= start of last tail
b. j5, f30, e5, c10, b5, a20
w.
m.insertproc
f0: 0 ; fpbase
f1: 0 ; slangbase
f2: 0 ; slang return address
f3: 0 ; name address
f4: 0 ; result
f5: 4<12 + 10 ; space, name
f6: 2<12 + 10 ; nl , name
f7: 2<12 + 2 ; nl , empty
f8: 3<12 ; end command
f9: 1<23 + 4 ; modekind= <bs>
e0: rs. w1 f0. ; insertproc:
al w3 x3-6 ; return to entry.no
ds. w3 f2. ; save(fpbase, slangbase, slang return);
rl w2 x1+h8 ; search next line:
a0: ba w2 x2+1 ; cc:= current command;
rl w0 x2 ; for cc:= cc+commstack(cc+1) while
se. w0 (f7.) ; delimiter >= 4 or
sl. w0 (f8.) ; (delimiter,kind)<>(nl,empty) do;
jl. a0. ; next command line found:
se. w0 (f6.) ; if (delimiter,kind)<>(nl,name)
jl. c1. ; then goto no name error;
am. (f1.) ;
rl w3 8 ; w3:= result name addr:= slangbase(8);
sn w3 -1 ; if result name addr = -1
jl. c1. ; then goto no name error;
dl w1 x3+2 ; result name found:
sn w0 (x2+2) ;
se w1 (x2+4) ; new name:= commstack(cc+2);
jl. c6. ; if new name <> result name
dl w1 x3+6 ; then goto name error2;
sn w0 (x2+6) ;
se w1 (x2+8) ;
jl. c6. ;
al. w1 g0. ; treat first tail:
rl w0 x1 ; tail:= first tail addr;
sh w0 -1 ; if kind.tail <= 0
jl. c2. ; then goto kind error2;
a5: al w1 x1+20 ; for tail:= tail + 20 while
sl. w1 g1.+20 ; tail<>last tail do
jl. a6. ;
dl w0 x2+4 ;
ds w0 x1+4 ; doc name.tail:= new name;
dl w0 x2+8 ;
ds w0 x1+8 ;
jl. a5. ;
a6: al. w1 g0.-20 ; tail addr:= first tail addr - 20;
jl. a8. ; goto start loop;
\f
;rc 1976.03.11 insertproc page ...2...
a7: bl w0 x2 ; next entry:
sh w0 3 ; if delim < 4
jl. c1. ; then goto no name error;
rl w0 x2 ; (delim,kind):=commstack(cc);
se. w0 (f5.) ; if (delim,kind)<>(space,name)
jl. c5. ; then goto name error1;
a8: al w3 x2+2 ; name addr:= cc+2;
al w1 x1+20 ; tail addr:= tail addr + 20;
jd 1<11+44 ; change entry:
sn w0 0 ; if changed then
jl. a10. ; goto test last;
sn. w1 g0. ; if first entry
jl. c0. ; then goto change error;
jd 1<11+40 ; create entry:
se w0 0 ; if not created then
jl. c7. ; goto create error;
a10: al w2 x2+10 ; test last: cc:= cc + 10;
sh. w1 g1.-1 ; if more tails
jl. a7. ; then goto next entry;
bl w0 x2 ; delim:= comstack(cc);
sl w0 4 ; if delim >= 4
jl. c5. ; then goto name error1;
al w2 x2-10 ; cc:= cc - 10;
am. (f0.) ; comment backspace current command;
rs w2 h8 ; current command:= cc;
al w0 0 ; text:= empty;
al w2 0 ; ok:= true;
jl. (f2.) ; return to slang;
\f
;rc 10.10.1972 insertproc page 3
;errors:
;w0= result, w3 = name address
f10: <:<10>insertproc: <0>:>
f11: <: name missing<10><0>:>
f12: <: cat function forbidden<10><0>:>
f13: <: device not ready<10><0>:>
f14: <: unknown<10><0>:>
f15: <: protected<10><0>:>
f16: <: area process in use<10><0>:>
f17: <: no resources<10><0>:>
f18: <: catalog inconsistent<10><0>:>
f19: <: catalog base error<10><0>:>
f20: <: name format<10><0>:>
f21: <: kind error<10><0>:>
f22: <: name trouble<10><0>:>
b0: 4
c7: sl w0 4 ; create error: if result>=4 then
wa. w0 b0. ; result:= result + 4;
jl. c0. ; goto error;
c5: al w3 x2+2 ; name error1: name addr:= commstack(cc+2);
c6: am 1 ; name error2: result:= 12; goto error;
c2: am 11 ; kind error2: result:= 11; goto error;
c1: al w0 0 ; no name error: result:= 0;
c0: ds. w0 f4. ; error:
rl. w1 f0. ; save(name addr,result);
rs w2 x1+h8 ; current command:= cc;
al. w0 f10. ;
jl w3 x1+h31-2 ; outtext(<:insertproc: :>);
rl. w2 f4. ;
sn w2 0 ; if result<>0 then
jl. a11. ;
rl. w0 f3. ; outtext(name);
am. (f0.) ;
jl w3 h31-2 ;
a11: bl. w2 x2+b1. ; text:= texttable(result);
j0: al. w0 x2 ;
al w2 1 ; ok:= false;
jl. (f2.) ; return to slang;
h.
b1: f11-j0, f12-j0, f13-j0, f14-j0, f15-j0, f16-j0; text table(0:5)
f17-j0, f18-j0, f17-j0, f19-j0, f20-j0, f21-j0; text table(6:11)
f22-j0 ; text table(12:12)
w.
jl. e0. ; entry to insertproc
j. ; goto insertproc
e. ; end insertproc block
i.
e. ; end tail names block
e. ; end fp names block
\f
▶EOF◀