|
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: 26112 (0x6600)
Types: TextFile
Names: »copy3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »copy3tx «
; rc 1979.04.04 copy skip
; jens ramsbøl, (tove ann aris)
b. g2, f9 w. ; start insertproc block
s.w. ; start code block
d.
p.<:fpnames:>
l.
; global names:
; a-names: main-program names
; b-names: global parameters
; c-names: case-names
; d-names: procedure names
; e-names: error-handling programs and procedures
; h-names: fp-procedures
; local names:
; i-names: local parameters
; j-names: local labels
b.a10,b27,c10,d25,e10
k=h55
w.
; definition of global parameters:
b0: 0 ; <ok-byte><message.yes or no>
b1: 0 ; output zone desc. addr
b2: 0 ; termchar
b3: 0 ; appearences
b4: 1<12 ; graphic
b5: 0 ; testsum
b6: 0 ; bigchar(no of chars>=128)
b7: 768 ; no of chars per segm
b8: 0 ; no of chars (outside transfer)
0 ; temp.
b9: 0 ; accumulated sum
b10: 0 ; addr(outfile-name)(:=0 if no outfile)
b11: 0 ; pointer(last item in command)
b12: 0 ; pointer(first item in command)
b13: a0. ; first free addr after program, after initialization: pointer(param)
b14: 0 ; addr of program name
b15: 0 ; 0 for copy, 1 for skip
b16: 0 ; accumulated sum of bigchars
b17: 0 ; accumulated sum of chars
0 ; accumulated
b18: 0 ; sum of testsums
b19: 1 ; list.yes list.no
b20: 0 ; save addr for links
b21: 0 ; save addr for links
b22: 0 ; save addr for links
b23: 0 ; save addr for links
b24: <:cur.input<0>:>
b25: 0 ; blind
b26: 0 ; sub
b27: 0 ; accumulated sub
; interprete command
; by exit: b11= pointer(last item in command)
; b12= pointer(first item in command)
; b13= pointer(first param)
; w1=addr(first item in next command)
b.j8
w.
a1: rl.w1 b11. ; load pointer(last item in last command);
j0: jl.w3 d0. ; next param:
jl. a2. ; end, .<param>
jl. j1. ; <s><name>
; <s><integer>
al w2 x1+2 ; pointer(first item)(b12):=poiter;
ds.w2 b13. ; pointer(param)(b13):=pointer+2;
jl.w3 d1. ; next item:
jl. c5. ; end,<s>
jl. e2. ; . <name>
; . <integer>
jl.w3 d1. ; next item:
jl. c6. ; end,<s>
jl. e2. ; . <name>
jl. e2. ; . <integer>
j1: al w2 x1+2 ; pointer(first item)(b12):=pointer;
ds.w2 b13. ; pointer(param)(b13):=pointer+2;
jl.w3 d1. ; next item:
jl. c1. ; end,<s>
jl. j2. ; . <name>
; . <integer>
jl.w3 d1. ; next item:
jl. c2. ; end,<s>
jl. e2. ; . <name>
; . <integer>
jl.w3 d1. ; next item:
jl. c3. ; end,<s>
jl. e2. ; . <name>
jl. e2. ; . <integer>
j2: jl.w3 d1. ; next item:
jl. c7. ; end,<s>
jl. e2. ; . <name>
; . <integer>
jl.w3 d1. ; next item:
jl. c4. ; end,<s>
jl. e2. ; . <name>
jl. e2. ; . <integer>
e.
; terminate copy
b.j3
w.
a2: al w1 0 ;
rs.w1 b25. ; blind:=0
rl.w1 b27. ;
rs.w1 b26. ; sub:=accumulated sub
rl.w1 b17. ;
sn.w1(b8.) ; if accumulated char<>char then
jl. j0. ; begin
rs.w1 b8. ; transfer accumulated
rl.w1 b16. ; datas to temporary
rs.w1 b6. ; registers
dl.w1 b18. ; end
ds.w1 b9. ;
rl.w2 b10. ; if left side in call then
se w2 0 ;
jl.w3 d10. ; write message;
j0: rl.w1 b10. ;
sn w1 0 ; if no outfile then
jl. j1. ; goto end of copy;
rl.w1 b1. ;
jl.w3 h95. ; close up-as it should be;
jl.w3 h79. ; terminate zone;
bz.w1 h19.+h1+1 ; decrease bs area:
se w1 4 ; if kind(output-file)=4(=>bs area) then
jl. j1. ; begin
al.w1 b10. ; b10 is used as tail area;
al.w3 h19.+h1+2 ; name addr:=name addr in zone desc;
jd 1<11+42 ; lookup entry(tail addr,name addr);
se w0 0 ; if result<>0 then goto end;
jl. j1. ;
rl.w0 h19.+h1+16; insert no of segments
rs.w0 b10. ; in tail area;
jd 1<11+44 ; change entry(tail addr,name addr);
j1: bz.w2 b0. ; end: load return value;
jl.w3 h7. ; end of copy, return to fp;
e.
; terminate copy(sorry);
a3: al w2 1<1+1 ; set warning and ok.no bit;
jl.w3 h7. ; end of copy, return to fp;
; procedure connect error
; call: return:
; w0 error cause destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed
b. i4 w.
e1: ds.w0 b22. ; save link and cause;
jl.w3 d11. ; write error text;
rl.w0 b13. ;
jl.w3 h31.-2 ; write out <file>;
rl. w2 b22.
al. w0 i0.
sn w2 1
al. w0 i1.
sn w2 3
al. w0 i2.
sn w2 4
al. w0 i4.
sn w2 5
al. w0 i3.
jl. w3 h31.-2
jl. (b21.) ; exit:
i0: <: error<10><0>:>
i1: <: no resources<10><0>:>
i2: <: not found<10><0>:>
i3: <: in use<10><0>:>
i4: <: convention error<10><0>:>
e.
; param error
; the routine writes out an error text together with the
; erroneous parameterstring and updates the pointer to
; next command
b.j3
w.
e2: jl.w3 d12. ; write error text;
j0: rl.w2 b12. ; pointer:=pointer(item);
bz w1 x2+1 ; param:=param(item);
se w1 4 ; if param=<integer> then
jl. j1. ;
rl w0 x2+2 ;
jl.w3 h32.-2 ; write out 'integer';
1 ; format structure;
jl. j2. ; else
j1: al w0 x2+2 ; write out 'name';
jl.w3 h31.-2 ;
j2: rs.w2 b11. ; pointer(last item):=pointer;
ba w2 x2+1 ; pointer:=pointer(next item);
bz w1 x2 ; sep:=seperator(next item);
se w1 8 ; if sep<>'.' then
jl. j3. ; goto end;
rs.w2 b12. ; save pointer;
al w2 46 ;
jl.w3 h26.-2 ; outchar '.';
jl. j0. ; next loop;
j3: al w2 10 ; char:=<nl>;
jl.w3 h26.-2 ; outchar(char);
jl. a1. ; exit: gto interprete command;
e.
; error no space for share
e4: jl.w3 d14. ; write error text;
jl. a3. ; goto terminate copy;
; case 1
; command: <infile>
c1: jl. w3 d16. ; test copy or skip
jl. c10. ; if skip then goto skip param
jl.w3 d2. ; connect infile;
al w0 25 ; termchar:=<em>;
al w1 1 ; app:=1;
ds.w1 b3. ;
rl.w1 b10. ; if no left side in call then
sn w1 0 ; no output<=>
rs.w1 b1. ; b1:=0;
jl.w3 d8. ; transfer;
rl.w1 b10. ; if no outfile then
al.w3 h21. ; out.zone addr:=current out.zone;
sn w1 0 ;
rs.w3 b1. ;
jl. c8. ;
c10: ; skip param:
jl. w3 d7. ; test one small letter
al w1 1 ; app:=1
ds. w1 b3. ; termchar:=letter
jl. w3 d8. ; transfer;
jl. a1. ; goto interprete command
; case 2
; command: <small letter>.<app>
c2: jl.w3 d4. ;
jl. c9. ;
; case 3
; command: <infile>.<iso-value>.<app>
c3: jl. w3 d16. ; test copy or skip
jl. e2. ; if skip then goto param error
jl.w3 d2. ; connect infile;
jl.w3 d5. ; case 6 routine;
jl. c8. ;
; case 4
; command: <infile>.<small letter>.<app>
c4: jl. w3 d16. ; test copy or skip
jl. e2. ; if skip then goto param error
jl.w3 d2. ; connect infile;
jl.w3 d4. ; test iso-value etc.
c8: jl.w3 d6. ; write message;
jl.w3 d3. ; disconnect infile;
jl. a1. ; exit: goto interprete command;
; case 5
; command: <lines>
c5: al w0 10 ; termchar:=<nl>;
rl.w1(b13.) ; app:=app;
ds.w1 b3. ;
al w0 0 ;
rs.w0 b4. ; graphic:=0;
jl.w3 d8. ; transfer;
rl.w1 b10. ; if no left side incall then
al w0 -1 ;
rs.w0 b4. ; 'graphic'is set to a nonzero value;
jl. c9. ;
; case 6
; command: <iso-value>.<app>
c6: jl.w3 d5. ;
c9: al.w2 b24. ; load addr(<:cur.input:>);
jl.w3 d10. ; write message;
jl. a1. ; goto interprete command;
; case 7
; command: message.yes, message.no, list.yes , list.no
; b15(0:11): 0(yes), 1(no)
b.i3,j1
w.
c7: jl. w3 d16. ; test copy or skip
jl. e2. ; if skip then goto param error
rl.w3(b13.) ; load param(pointer);
se.w3(i0.) ; if param(0:2)<>'mes'
sn. w3 (i3.) ; and param<>list
jl. 4 ; then
jl. j1. ; goto fejl;
rl w3 x1-8 ; if next param='yes' then
sn.w3(i1.) ; message.yes;
jl. j0. ; goto exit;
se.w3(i2.) ; if next param='no' then
j1: jl. e2. ; message.no;
am 1 ; goto exit;
j0: al w1 0 ; error: goto param error;
rl. w3 (b13.) ;
sn. w3 (i0.) ; if message then
hs. w1 b0.+1 ; save message state;
sn. w3 (i3.) ; if list then
rs. w1 b19. ; save list state;
jl. a1. ; exit: goto interprete command;
i0: <:mes:>
i1: <:yes:>
i2: <:no:>
i3: <:lis:>
e.
; procedure next item
; the procedure tests next item, updates the pointer(b11) if
; necessary, and returns to link, link+2,etc., corresponding
; to the cases:
; item: d0: d1:
; end link link
; <s><name> link+2 link
; <s><integer> link+4 link
; . <name> link link+2
; . <integer> link link+4
;
; call: return:
; w0 destroyed
; w1 pointer(last item) pointer(item)
; w2 destroyed
; w3 link destroyed
b.j0
w.
d1: am 4 ; testsep:='.';
d0: al w2 4 ; testsep:=<s>;
ba w1 x1+1 ; pointer:=pointer(item);
bz w0 x1 ; sep:=seperator(item);
se w0 x2 ; if sep<>testsep then
jl. j0. ; goto exit;
al w3 x3+2 ; link:=link+2;
bz w0 x1+1 ; param:=param(item);
rs.w1 b11. ; save pointer;
se w0 10 ; if param=<integer> then
al w3 x3+2 ; link:=link+2;
j0: jl x3 ; exit: goto link;
e.
; procedure connect infile
; call: return:
; w0 0 if no error
; w1 destroyed
; w2 destroyed
; w3 link destroyed
b.j0
w.
d2: rs.w3 b20. ; save link;
jl.w3 h29.-4 ; stack current input;
rl.w2 b13. ; load addr(infile-name);
jl.w3 h27.-2 ; connect <infile> to current input;
sn w0 0 ; if error then
jl. j0. ; write error-message;
jl.w3 h30.-4 ; unstack current input;
jl.w3 e1. ;
jl. a1. ; goto interprete command;
j0: rl.w3 b13. ;
al w3 x3+10 ; pointer(param):=addr(next param);
rs.w3 b13. ;
jl. (b20.) ; exit:
e.
; procedure disconnect infile
; call: return:
; w0 unchanged
; w1 destroyed
; w2 destroyed
; w3 link destroyed
b.
w.
d3: rs.w3 b20. ; save link;
jl.w3 h79.-4 ; terminate current input;
jl.w3 h30.-4 ; unstack current input;
jl. (b20.) ; exit:
e.
; procedure used of c2 and c4
; call: return:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed
b.
w.
d4: rs.w3 b20. ; save link;
jl.w3 d7. ; test param;
rl.w2 b13. ; pointer:=pointer(next param);
al w2 x2+6 ;
rs.w2 b13. ;
jl.w3 d9. ;
jl. (b20.) ; exit
e.
; procedure used of c3 and c6
; call: return:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed
b.
w.
d5: rl.w0(b13.) ; load pointer;
d9: rs.w3 b21. ; save link;
sl w0 0 ;
sl w0 127 ; between 0 and 127
jl. e2. ;
rl.w1 b13. ;
rl w1 x1+4 ; termchar:=<iso-value>;;
ds.w1 b3. ;
jl.w3 d8. ; transfer;
jl. (b21.) ; exit:
e.
; procedure write message
; call: return:
; w0 addr(file) destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed
b. i6, j7
w.
i0: 1000000 ;
i1: <: <0>:> ;
i2: 0, r.4 ;
<:segm.<0>:> ;
i3: <: >127: :>
i4: <: sub: :>
i5: <: blind: :>
i6: 10
d6: rl.w2 b12. ; load pointer(first item);
al w2 x2+2 ; pointer:=pointer(file-name);
d10: rs.w3 b22. ; save link;
dl w1 x2+2 ;
lo. w0 i1. ;
lo. w1 i1. ;
ds. w1 i2.+2 ;
dl w1 x2+6 ;
lo. w0 i1. ;
lo. w1 i1. ; extend name
ds. w1 i2.+6 ; with spaces
al. w0 i2. ;
bz.w2 b0.+1 ;
se w2 0 ; if message.no then
jl. j7. ; goto exit;
jl.w3 h31.-2 ; outtext <file>;
al w0 767 ;
al w3 0 ;
wa. w0 b8. ;
wd. w0 b7. ;
jl. w3 h32.-2 ; outinteger(segm)
32<12+4 ;
rl.w0 b8. ;
jl.w3 h32.-2 ; outinteger <number of chars>;
32<12+ 8 ; format structure;
al w2 47 ; char:=</>;
jl.w3 h26.-2 ; outchar;
dl.w0 b9. ; w0:=sum/10**6;
wd.w0 i0. ; w3:=sum mod 10**6;
rs.w3 b9. ;
sn w0 0 ; if kvotient=0 then
jl. j1. ; goto write sum;
jl.w3 h32.-2 ; outinteger <kvotient>;
1 ; format structure;
rl.w0 b9. ;
jl.w3 h32.-2 ; outinteger <modulo>;
48<12+6 ; format structure;
jl. j3. ;
j1: rl.w0 b9. ; write sum:
jl.w3 h32.-2 ; outinteger <sum>;
1 ; format structure;
rl. w0 b9. ; if char=0 then
sn w0 0 ; char:=char+1;
ba. w0 1 ;
j2: al w3 0 ; next:
wm. w0 i6. ; char:=char*10;
sh w0 0 ; if char
jl. j3. ; >1000000
sl. w0 (i0.) ; then
jl. j3. ; exit;
al w2 32 ;
jl. w3 h26.-2 ; outchar(sp);
jl. j2. ; goto next;
j3: rl.w0 b6. ;
sn w0 0 ; if sum of bigchars>0 then
jl. j4. ;
al. w0 i3. ;
jl. w3 h31.-2 ; outtext(<: >127 :>
rl. w0 b6. ;
jl.w3 h32.-2 ; outinteger <bigchar>;
1 ; format structure;
j4: rl. w0 b26. ; if sub=0 then
sn w0 0 ; skip;
jl. j5. ;
al. w0 i4. ;
jl. w3 h31.-2 ; outtext(<: sub :>
rl. w0 b26. ;
jl. w3 h32.-2 ; outinteger(sub);
1 ; layout
j5: rl. w0 b25. ; if blind=0 then
sn w0 0 ; skip;
jl. j6. ;
al. w0 i5. ;
jl. w3 h31.-2 ; outtext(<: blind :>);
rl. w0 b25. ;
jl. w3 h32.-2 ; outinteger(blind);
1 ; layout
j6: al w2 10 ; char:=<nl>;
jl.w3 h26.-2 ; outchar(char);
j7: jl. (b22.) ; exit:
e.
; procedure test one small letter
; call: return:
; w0 <iso-value> (if ok)
; w1 0 (if ok)
; w2 param addr destroyed
; w3 link destroyed
b.
w.
d7: rl.w1 b13. ;
dl w1 x1+2 ; load, param, param+2
ld w1 -16 ;
sn w1 0 ;
jl x3 ; exit: goto link;
jl. e2. ; error: goto param error;
e.
; procedure transfer
; the procedure takes a character from the input zone, tests
; it, updates 'number' and 'sum' and outputs the char on the
; output-zone
; call: return:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed
b.i1,j11
w.
d8: rs.w3 b22. ; save link;
al w0 0 ;
al w1 0 ;
ds.w1 b6. ; initiate counting words;
ds.w1 b9. ;
ds. w1 b26. ;
jl. j0. ;
j10: rl. w3 b25. ;
al w3 x3+1 ; blind:=blind+1;
rs. w3 b25. ;
j0: rl.w3 b3. ; if app=0 then
rs.w0 b8.
sn w3 0 ; goto last
jl. j8.
jl.w3 h25.-2 ; inchar from current input;
rs. w2 b8. ; save char;
sn.w2(b2.) ; if char=termchar then
jl. j7. ; goto found;
se w2 0 ; if char=0 or 127 then
sn w2 127 ; skip char+
jl. j10. ; goto nextchar;
sn w2 25 ; if char=<em> then
jl. j6. ; goto input exhausted;
se w2 26 ;
jl. j11. ;
rl. w3 b26. ;
al w3 x3+1 ; sub:=sub+1;
rs. w3 b26. ;
j11: sh w2 126 ; if 32<char<127 then
sh w2 33 ; (<=> char is graphic)
jl. j1. ; set 'graphic'>0;
hs.w2 b4.+1 ;
j1: al w3 x2 ; continue:
wa.w3 b5. ; sum:=sum+char;
sl.w3(i0.) ; if sum>=8388000 then
jl. j5. ; goto update;
j2: rs.w3 b5. ;
sl w2 128 ; if char>=128 then
jl. j4. ; goto bigchar;
wa.w0 i1. ; number:=number+1;
j3: rl.w1 b1. ; if no output then
se w1 0 ; goto nextchar;
jl.w3 h26. ; outchar;
rl. w1 b19. ; if list.no then
se w1 0 ; goto next char;
jl. j0. ;
rl. w2 b8. ;
jl. w3 h26.-2 ; outchar(cur out);
jl. j0. ; goto nextchar;
j4: rl.w3 b6. ; bigchar:
al w3 x3+1 ;
rs.w3 b6. ; bigchar:=bigchar+1;
jl. j3. ;
j5: al w2 0 ;
aa.w3 b9. ; accumulatedsum:=
ds.w3 b9. ; accumulatedsum+sum;
al w3 0 ; sum:=0;
rl.w2 b8. ; load char;
jl. j2. ;
j6: rs.w0 b8. ; save 'no of chars';
jl.w3 d13. ; write error message;
rl.w0 b8. ;
al w3 0 ;
jl. j8. ;
j7: rl.w3 b4. ; found:
sn w3 0 ; test if any graphic chars
jl. j1. ; since last <nl>(only in function
al w3 0 ; when the command is <lines>);
hs.w3 b4.+1 ; graphic:=0;
rl.w3 b3. ;
al w3 x3-1 ; app:=app-1;
rs.w3 b3. ;
sl w3 1 ; if app>0 then
jl. j1. ; goto continue
sn w2 10 ; if termchar=10 then
jl. j1. ; goto continue;
; end of transfer:
rs.w0 b8. ; save number of chars;
j8: wa.w0 b17. ; accumulate 'number of chars';
rs.w0 b17. ;
dl.w1 b6. ;
aa.w0 b9. ; save testsum;
ds.w0 b9. ;
aa.w0 b18. ; accumulate testsum;
ds.w0 b18. ;
wa.w1 b16. ; accumulate number of bigchar;
rs.w1 b16. ;
rl.w0 b26. ; accumulate sub
wa.w0 b27. ;
rs.w0 b27. ;
bz.w0 b0.+1 ;
rl.w1 b1. ;
am -1000
sn.w1 h21.+1000 ; outfile=current output and
se w0 0 ; then message.yes and
jl. j9. ; outchar(nl);
al w2 10 ;
jl.w3 h26.-2 ;
j9: jl. (b22.) ; exit:
i0: 8388000 ;
i1: 1 ;
e.
; procedure error text
; the procedure writes out an error text and sets the ok-byte
; call: return:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed
b.i5
w.
i0: <:***<0>:>
i1: <: connect <0>:>
i2: <: param <0>:>
i3: <: end medium<10><0>:>
i4: <: no core<10><0>:>
i5: <: call<10><0>:>
d15: am i5-i4 ; error : call
d14: am i4-i3 ; error: no core
d13: am i3-i2 ; error: end medium
d12: am i2-i1 ; error: param
d11: al.w2 i1. ; error: connect
al w0 2 ; set warning bit;
hs.w0 b0. ;
al.w0 i0. ;
rs.w3 b23. ; save link;
jl.w3 h31.-2 ; output error message on current output;
rl. w3 b14. ;
al w0 x3+2 ;
jl. w3 h31.-2 ; write(out,programname)
al w0 x2 ;
jl.w3 h31.-2 ;
jl. (b23.) ; exit:
e.
; procedure copy or skip
; call return
; w0 destroyed
; w1
; w2
; w3 link link
d16: al w0 0 ;
se. w0 (b15.) ;
jl x3 ; return skip
jl x3+2 ; return copy
; init copy
b.i0,j1
w.
f1: ; entry copy
a0: rs.w3 b11. ; save pointer(item);
rs. w3 b14. ; save program name
sn x2 w3 ; if no left side in call then
jl. a1. ; goto interprete commands;
al w2 x2+2 ; addr:=addr(outfile name);
rs.w2 b10. ; save addr;
al.w1 b13. ;
wa.w1 b13. ; save first free
rs.w1 b13. ; addr after program;
al w0 x1+512 ; is there space enough for
sl w0 x3 ; a share between the pg.
jl. e4. ; and the command stack
am -2048
al.w1 h19.+2048 ;
rs.w1 b1. ;
jl.w3 h79. ; terminate current program zone
rl.w3 b13. ;
am -2048
rs.w3 h80.+2+2048; insert share in share desc.
al w0 1<1+ 1 ;
jl.w3 h28. ; connect <outfile> to current pg. zone;
sn w0 0 ; if no error then
jl. j0. ; exit: goto changeentry;
rl.w3 b10. ; else
rs.w3 b13. ;
jl.w3 e1. ; write out errror-message;
jl. a3. ; goto terminate(sorry);
j0: bl w0 x1+h1+1 ;
sn w0 4 ; if -,bs and
jl. 6 ; -,mt
se w0 18 ; then
jl. a1. ; goto interprete commands;
am -1000
al. w1 h54.+1000 ; w1:=lookup area;
rl. w2 b10. ; w2:=name addr
jl. w3 f9. ; prepare entry for textoutput
jl. a1. ; goto interprete commands
e.
; init skip
f2: al w0 1 ; entry skip:
rs. w0 b0. ; message.no
ds. w0 b15. ; save program name
rs. w3 b11. ; save pointer(item)
sn w2 x3 ; if no left side then
jl. a1. ; goto interprete param
jl. w3 d15. ; else goto error call
jl. a3. ; goto terminate(sorry)
f9:
; procedure prepare entry for textoutput
; w0 not used
; w1 lookup area
; w2 name addr, entry must be present
; w3 return addr
b. a2 w.
ds. w1 a1. ; save w0.w1
ds. w3 a2. ; save w2.w3
al w3 x2 ; w3:=name addr
jd 1<11+42 ; lookup
bz w2 x1+16 ;
sh w2 32 ; if contents=4 or
sn w2 4 ; contents>=32
jl. 4 ; then
jl. a0. ; file:=block:=0;
rs w0 x1+12 ;
rs w0 x1+14 ;
a0: rs w0 x1+16 ; contents.entry:=0;
rs w0 x1+18 ; loadlength:=0;
dl w1 110 ;
ld w1 5 ; shortclock;
rl. w1 a1. ;
rs w0 x1+10 ;
jd 1<11+44 ; changeentry;
dl. w1 a1. ; restore w0,w1
dl. w3 a2. ; restore w2,w3
jl x3 ; return
0 ; saved w0
a1: 0 ; saved w1
0 ; saved w2
a2: 0 ; saved w3
e.
e.
; end of copy
f3=k-h55 ; length of copy skip
m.rc 1978.04.17 copy skip
; insert tails in catalog
; the entries are given by f1 and f2
; load length by f8
f8=k-h55
; entry copy
g0: (:f8+511:)>9 ; no. of segm
0, r.4 ;
s2 ; date
0,0 ; file, block
2<12+f1-h55 ; contents, entry
f3 ;
; entry skip
g1: 1<23+4 ; bs
0, r.4 ;
s2 ; date
0,0 ; file, block
2<12+f2-h55 ; contents, entry
f3 ; length
d.
p.<:insertproc:>
l.
e.
e.
▶EOF◀