|
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: 47616 (0xba00)
Types: TextFile
Names: »uti16«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦f8e4b63af⟧ »trcfput«
└─⟦this⟧
\f
; rc 25.3.72 editor i, tape 4, page 1.
; comment on search:
; the searching is performed for identifying a substring
; within another string. input bytes are compared with the
; first byte of the substring. when a match is found con-
; sequtive input bytes are matched with consequative
; bytes in the substring. does this matching not succed
; for the total substring a comparison is performed
; where the second and following bytes of the substring
; which mached are simulated as input bytes. thus
; recusively the matching part of the substring is
; backed up until the situation again is as mentioned
; above.
; as the identified substring may be removed from the
; original string a variable, cur fix, keep track of the
; last byte which was not in the substring. in the search
; procedure cur fix is set equal to cur obj when a input byte
; do not match with the first byte of the substring.
; when cur fix must be moved during backing up, the
; search procedure call an action procedure.
; the search procedure contain three entries:
; 1. init search: which set the initial parameters for the
; searching, and return to action (0).
; 2. next search: where the next input byte is recieved for
; matching. return is made to 1) action (0) if a
; new input byte is required, or to 2) action (10)
; when search back up thus leaving a possibility
; of updating cur fix. or to 3) next instr 4 when
; a matching substring is found.
; 3. step up: is the entry jumped to when exit has been
; made to action (10) and a possible updating of
; cur fix has been performed.
b. i6, h16 ; begin
w.
; integer
i2: 0 ; first sub,
i3: 0 ; last byte,
i4: 0 ; save w1,
i5: 0 ; up end,
i6: 0 ; first in;
; print searched string
; comment prints the string that was searched
; irrellevant register contents on entry, except
; w3 = return
c41: rl. w1 i2. ; cur corr := first sub;
al. w0 h0. ; action(4) := take next;
rs. w0 a40.+4 ;
al. w2 g43. ;
h0: bl w0 x1 ; take next: byte := byte(cur corr);
al w1 x1+1 ; cur corr := cur corr + 1;
sz w0 g20 ; if byte = <special> then
jl. c17. ; print text(<:<10>:>) and return;
jl. a46. ; goto print;
\f
; rc 17.6.69 editor i, tape 4, page 2.
a47: ; init search:
; w0: destroyed
; w1: saved
; w2: cur obj
; w3: cur corr
; return: action (0)
; return on empty substring: next instr 4;
; comment: the initial parameters for the search is set.
h. al w0, se w1 x1 ;
w. hs. w0 i1. ; skip:= false;
rs. w2 f59. ; cur fix:= cur obj;
al w0 x3+1 ;
rs. w0 i2. ; first sub:= cur corr + 1;
; match:
h1: al w3 x3+1 ; cur corr:= cur corr + 1;
bl w0 x3 ; byte:= byte (cur corr);
sz w0 g20 ; if byte = <special>
jl. a4. ; then goto next instr 4.
rs. w0 f60. ; sub byte:= byte;
jl. (a40.+0); goto action (0);
a48: ; action procedure next search;
; w0: in byte / destroyed or next instr byte
; w1: saved
; w2: cur obj
; w3: cur corr
; return for next inbyte: action (0)
; return for back up: action (12)
; return when match: next instr 4
h2: ; search next:
i1: ; boolean skip;
se. w1 x1 h5. ; if skip then goto skip comp;
sn. w0 (f60.) ; if inbyte = sub byte
jl. h1. ; then goto match;
sz w0 g21+g22+g23; if inbyte = (<comp> ! <non gr> ! <blind>)
jl. h3. ; then goto test comp
se. w3 (i2.) ; if cur corr <> first sub
jl. h6. ; then goto back up;
; first no match:
h16: rs. w2 f59. ; cur fix:= cur obj;
jl. (a40.+0); goto action (0);
\f
; rc 17.6.69 editor i, tape 4, page 3.
; test comp:
h3: sz w0 g21 ; if byte = <comp>
jl. h15. ; then goto comp;
sn. w3 (i2.) ; if cur sub = first sub
rs. w2 f59. ; then cur fix := cur obj;
jl. (a40.+0); goto action(0);
h15: ; comp:
rs. w3 f43. ; save w3:= cur sub;
jl. w3 c12. ; search comp (
jl. h1. ; goto match);
se. w3 (i2.) ; if cur sub <> first sub
jl. h6. ; then goto back up;
h4: ; skip comp 1:
h. al w0, jl. ; skip:= true;
w. hs. w0 i1. ;
jl. (a40.+0); goto action (0);
; skip comp:
h5: sz w0 g21 ; if inbyte = <comp>
jl. (a40.+0); then goto action (0);
h. al w0, se w1 x1 ; skip:= false;
w. hs. w0 i1. ;
bl. w0 (i2.) ; subbyte:= byte(first sub);
rs. w0 f60. ;
jl. h16. ; goto first no match;
; back up:
h6: ds. w1 i4. ; last byte:= inbyte; save (w1);
rs. w3 i5. ; up end:= cur corr;
rl. w1 i2. ; cur in:= first sub;
jl. (a40.+12); goto action (12);
a49: ; action procedure step up;
; comment: entry after call of action (12). the registers
; w1, and w2 must not be changed during the call;
h7: ; step 1:
rl. w3 i2. ; cur corr:= first sub;
bl w0 x3 ; subbyte:= byte(cur corr);
rs. w0 f60. ;
bl w0 x1 ; inbyte:= byte (cur in);
so w0 g21 ; if inbyte = <comp> then
jl. h8. ; begin
al w1 x1+1 ; cur in:= cur in + 1;
sn. w1 (i5.) ; if cur in = up end
jl. h14. ; then goto comp found;
jl. h7. ; goto step 1
; end;
h8: al w1 x1+1 ; cur in:= cur in + 1;
sn. w1 (i5.) ; if cur in = up end
jl. h11. ; then goto up found;
rs. w1 i6. ; first in:= cur in;
al w3 x3-1 ; cur corr:= cur corr - 1;
\f
; rc 9.1.70 editor i, tape 4, page 4.
; up match:
h9: al w3 x3+1 ; cur corr:= cur corr + 1;
bl w0 x3 ;
rs. w0 f60. ; subbyte:= byte (cur corr);
; next up:
h10: al w1 x1+1 ; cur in:= cur in + 1;
sh. w1 (i5.) ; if cur in < up end
jl. h12. ; then goto test match
; up found:
h11: dl. w1 i4. ; inbyte:= last byte; restore (w1);
jl. h2. ; goto search next;
; test match:
h12: bl w0 x1-1 ; in byte:= byte (cur in - 1);
sn. w0 (f60.) ; if inbyte = subbyte
jl. h9. ; then goto up match;
so w0 g21 ; if inbyte <> <comp>
jl. h13. ; then goto up;
; up comp:
rs. w3 f43. ; save w3:= cur corr;
jl. w3 c12. ; search comp (
jl. h9. ; goto up match);
; up:
h13: rl. w1 i6. ; cur in:= first in;
jl. (a40.+12); goto action (12);
; comp found:
h14: dl. w1 i4. ; in byte:= last byte; restore (w1);
sz w0 g21 ; if inbyte <> <comp>
jl. (a40.+0); then goto action (0);
jl. h4. ; else goto skip comp 1;
e. ; end search;
\f
; rc 9.1.70 editor i, tape 4, page 5.
a50: ; action procedure move fix;
; w0: destroyed
; w1: cur in
; w2: saved
; w3: saved
; cur fix: updated
; return: transfer control to action procedure search, step up.
;
; comment: cur fix, points on the first character in the object
; string, which is included in the matching substring.
; cur in, points on the character in the substring which during
; backup is ahead of the first inbyte in the next set for mat-
; ching.
; the procedure moves cur fix one step forward.
;
; the step consists in bypassing:
; <graphic or composed character> <blinds and non
; graphics> under the condition that byte(cur in + 1)
; is not among the blinds and non graphics, in which
; case cur fix points on the blind or non graphic.
;
b. h5, i2 ; begin
w. ;
bl w0 x1+1 ;
hs. w0 i1. ; next inbyte := byte(cur in + 1);
rx. w2 f59. ;
; skip comp:
h1: bl w0 x2 ;
al w2 x2+1 ; cur fix:= cur fix + 1;
sn. w2 (f48.) ; if cur fix = obj bottem
rl. w2 f47. ; then cur fix := obj top;
sz w0 g20+g21 ; if byte(cur fix-1) = (<special> or <comp>)
jl. h1. ; then goto skip comp;
; exam blind and non gr:
h2: rs. w2 i2. ; fix := cur fix;
; skip spec:
h3: bl w0 x2 ;
al w2 x2+1 ; cur fix := cur fix + 1;
sn. w2 (f48.) ; if cur fix = obj bottem
rl. w2 f47. ; then cur fix := obj top;
sz w0 g20 ; if byte(cur fix-1) = <special>
jl. h3. ; then goto skip spec;
sz w0 g22+g23 ; if byte(cur fix) = (<blind> or <non gr>)
jl. h5. ; then goto next inbyte;
; exit:
h4: rl. w2 i2. ;
rx. w2 f59. ; cur fix := fix
jl. a49. ; goto step up;
h5: ; test next inbyte:
i1=k+1 ; integer next inbyte;
sn w0 0 ; if byte(cur fix) = next inbyte
jl. h4. ; then goto exit;
jl. h2. ; goto exam blind and non gr;
i2: 0 ; integer fix;
e. ; end move fix;
\f
; rc 17.6.69 editor i, tape 4, page 6.
b. h1 ; begin test of line:
w.
a51: ; action procedure test line;
; w0: destroyed
; w1: w2: w3: saved
; return: action (8) or next instr 2;
rl. w0 f44. ; begin
sh. w0 (f64.) ; if cur line <= line dest
jl. (a40.+8); then goto action (8)
jl. a2. ; else goto next instr 2;
; end;
a53: ; action procedure gen test line;
a22: ; w0: destroyed
; w1: w2: saved
; w3: irrelevant / updated cur corr
; return: next instr 3;
rl. w0 f64. ; begin
se w0 -1 ; if line dest = -1
sl. w0 (f44.) ; line dest >= cur line
am f57-f58 ; then cur corr:= gen first instr
rl. w3 f58. ; else cur corr:= gen last instr;
jl. a3. ; goto next instr 3;
; end;
a54: ; action procedure glob test em;
; comment: cur corr is set equal to glob last instr -1
; and control is transfered to test em;
rl. w3 f58. ; cur corr:= glob last instr -1;
al w3 x3-1 ; goto test em;
a52: ; action procedure test em;
; w0: destroyed
; w1: w2: saved
; w3: cur corr / updated cur corr
; comment: if line dest is not negative or equal to
; cur line an alarm is given. the next instruction is
; examined, if it is uphead it is changed to head.
; control is transfered to next instr 4;
rl. w0 f64. ; begin
sl w0 0 ; if line dest >= 0
sn. w0 (f44.) ; & cur line <> line dest
jl. 4 ; then
jl. c23. ; goto alarm(position not found);
al w3 x3+1 ; cur corr:=cur corr +1;
bl w0 x3 ; byte:= byte (cur corr);
se w0 b27 ; if byte = <uphead> or
sn w0 b37 ; byte:= <head> then
jl. a2. ; goto next instr 2
jl. a4. ; else goto instr 4;
; end;
e. ; end test line;
\f
; rc 29.06.71 editor i, tape 4, page 7.
a55: ; action procedure print em
; w0: destroyed
; w1: w2: w3: saved
; return: action (14);
;
; comment: the value of cur line and the text
; <: end of document:> is printed;
ds. w2 f56. ; begin
rs. w3 f67. ; save (cur source, cur obj, cur corr);
am -2048 ;
al. w2 g43.+2048; printtext(<nl>);
jl. w3 c17. ;
rl. w0 f44. ;
jl. w3 c16. ; print value (cur line);
5 ;
am -2000 ;
al. w2 g31.+2000;
jl. w3 c17. ; print text (<:line, end of document:>);
rl. w3 f67. ;
dl. w2 f56. ; restore (cur corr, cur source, cur obj);
jl. (a40.+14); goto action (14);
; end;
\f
; rc 29.06.71 editor i, tape 4, page 8.
b. i1 w.
c9: ; procedure init source;
; w0: - / -
; w1: - / cur source pointing ahead of byte <no line>
; w2: name address / -
; w3: return / -
; error return: return
; ok return: return +2;
; begin
rs. w3 i1. ; save(return);
rl. w1 f28. ; w1:= source descr;
am. (f77.) ;
jl w3 h27 ; w0:= connect input(w1,w2);
rl. w1 f29. ; w1:= source line addr;
se w0 0 ; if w0 = connect error
jl. (i1.) ; then exit(error return);
al w0 g9 ;
hs w0 x1+1 ; byte(source line addr +1):= <no line>;
am. (i1.) ;
jl 2 ; exit(ok return);
;
i1: 0 ;
e. ; end init source;
\f
; rc 16.4.72 editor i, tape 4, page 9.
c10: ; procedure close obj;
; w0: - / -
; w1: - / -
; w2: cur obj / -
; w3: return / -
;
; comment: <top of line> is output, and the remaining lines are
; transfered from the object string to the object document.
; if the document are on the backing storage close up is made
; with the character <em>.
; wait and check is made.
; if extend is allowed the area is decreased to the necessary.
; if the source file is an intermediate work file it is removed;
b. d4, i4 ; begin
w. ;jl x3 ; if dummy obj then exit(return);
rs. w3 i1. ; save return;
al. w0 d1. ;
rs. w0 a40.+6 ; action(6):= here;
jl. a60. ; to obj top of line;
; here:
d1: rl. w1 f44. ; w1:= cur line;
; next line:
d2: jl. w3 c11. ; output line;
se. w1 (f45.) ; if cur line <> outline
jl. d2. ; then goto next line;
; close up:
rl. w1 f27. ; w1:= obj descr;
bz w3 x1+h1+1 ; w2 :=
se w3 4 ; if kind = bs
sn w3 18 ; or kind = mag tape
am w2 g7 a. 127 ; then em
al w2 0 ; else null
am. (f77.) ;
jl w3 h34 ; closeup(w1,w2);
\f
; rc 29.06.71 editor i, tape 4, page 10.
; terminate zone:
rl. w1 f27. ; w1:= obj descr;
c. h57<2 ; if system 2 then begin
bz w0 x1+h1+1 ; get document kind
sn w0 12 ; if kind = punch then
jl. w3 c40. ; outblanks;
z. ; end system 2;
am. (f77.) ;
jl w3 h79 ; terminate zone(w1);
; change object description
al w3 x1+h1+2 ; w3 := obj. descr. name address
bl. w2 f71. ;
se w2 0 ; if -, extend allowed then
jl. (i1.) ; exit (return);
; test intern source:
rl w1 x1+h1+16 ; number of segments := segment count;
rs. w1 f83. ;
al. w1 f83. ; w1 := tail address;
jd 1<11+44 ; change entry(w1,w3);
bl. w0 f72. ;
se w0 0 ; if interm source = false
jl. (i1.) ; then exit(saved return);
rl. w1 f28. ;
al w3 x1+h1+2 ; w3:= source descr.name;
jd 1<11+48 ; remove entry(w3);
c. h57<3 ; if system 3 then begin
am. (f27.) ;
al w3 +h1+2 ; w3 := obj name;
f91 = k+1 ; permanent key
al w1 ; w1 := permanent key;
se w1 0 ; if permanent key <> 0 then
jd 1<11+50 ; permanent entry(w1,w3);
dl. w1 f89. ; w0w1 := obj entry interval;
jd 1<11+74 ; change entry interval(w0,w1,w3);
z. ;
jl. (i1.) ; exit(saved return);
;
i1: 0 ; saved return;
;
e. ; end close obj;
\f
; rc 17.6.69 editor i, tape 4, page 11.
c35: ; procedur source param;
; w0: integer / -
; w1: - /cur source pointing ahead of first byte
; w2: -
; w3: return / -
; comment: in case of connect error alarm(connect source).
; if no parameter corresponds to the integer first byte is set
; to <empty source> otherwise to <no line>;
b. i1, d2 ; begin
w.
rs. w3 i1. ;
rl. w1 f29. ; w1:= source line address;
al w2 g13 ; byte(w1+1):= <empty source>;
hs w2 x1+1 ;
sn w0 0 ; if integer = 0 then goto empty;
jl. (i1.) ;
rl. w2 f78. ; w2:= fp current command;
; next param:
d1: ba w2 x2+1 ; w2:= w2+param size;
bl w3 x2 ; w3:= separator(w2);
sh w3 2 ; if w3 is a command terminator
jl. (i1.) ; then goto empty;
se w3 4 ; if w3 <> <spaces>
jl. d1. ; then goto next param;
bl w3 x2+1 ; w3:= param size(w2);
se w3 10 ; if w0 <> size of name
jl. d1. ; then goto next param;
bl w3 x2+10 ; w3:= next separator;
sl w3 6 ; if w3 = <equal> or <dot>
jl. d1. ; then goto next param;
bs. w0 1 ; integer:= integer -1;
se w0 0 ; if integer <> 0
jl. d1. ; then goto next param;
; parameter found:
al w2 x2+2 ; w2:= param name;
jl. w3 c9. ; init source(w2, w1=cur source);
jl. c34. ; if init error then alarm(connect source);
jl. (i1.) ; return;
; empty:
i1: 0 ;
e. ; end source param;
\f
; rc 29.06.71 editor i, tape 4, page 12.
c11: ; procedure output line;
; w0: destroyed
; w1: saved
; w2: cur obj
; w3: return / destroyed
; cur out: updated
; out line: updated
;
; comment: a line terminated by <top of line> is trans-
; fered from the object string to the object buffer.
; when a buffer is full a blocktransfer is initialized;
; when a drum area is full and extend is allowed
; a new extended object area is created, the filled
; up area is copyied to the extended area after which
; the old area is canseled.
; composed byte will cause output of an extra
; <bs> character.
; after transfer of a line outline is increased by
; one, but only if cur line is not equal out line in
; which case the total object string consist only of
; a partial line;
b. a10, i9 ; begin
w. ;
ds. w2 f42. ; save(w1,w2,w3);
rs. w3 f43. ;
rl. w1 f27. ; w1:= obj descr;
rl w0 x1+h2+4 ; w0:= obj descr.partial word;
; next block:
a1: rl. w3 f46. ; w3:= cur out;
; next byte:
a2: bl w2 x3 ; byte:= byte(cur out);
la. w2 f22. ; byte:= byte and (not blind and not gr);
sz w2 g20+g21; if byte = <special> or <comp>
jl. a7. ; then goto special;
al w3 x3+1 ; cur out:= cur out+1;
; pack:
f73: ;sn w1 x1+f19. ; boolean dummy obj;
a3: sz. w0 (f19.) ; if w0 contains two char or not dummy obj
jl. a4. ; then goto pack word;
ls w0 8 ;
wa w0 4 ; w0:= w0 + char(byte);
jl. a2. ; goto next byte;
; pack word:
a4: ls w0 8 ; w0:= w0 + char(byte);
wa w0 4 ;
rl w2 x1+h3+0 ; w2:= obj descr. record base;
al w2 x2+2 ; w2:= w2+2;
rs w2 x1+h3+0 ; obj descr.record base:= w2;
rs w0 x2 ; word(w2):= w0;
al w0 1 ; w0:= no character;
se w2 (x1+h3+2) ; if w2 <> obj descr.last byte;
jl. a2. ; then goto next byte;
\f
; rc 29.06.71 editor i, tape 4, page 13.
; output block:
rs. w3 f46. ; cur out:= w3;
am. (f77.) ;
jl w3 h23 ; outblock(w1);
c. h57<3 ; if system 3 then
jl. a1. ; goto next block;
z. ;
c. h57<2 ; if system 2 then begin
bl. w3 f71. ;
se w3 0 ; if extend allowed = false
jl. a1. ; then goto next block;
rl w3 x1+h1+16 ; if obj descr.segment count <>
se. w3 (f83.) ; obj no of segments
jl. a1. ; then goto next block;
; extend object document:
al w3 x3+d8 ; obj no of segments:=
rs. w3 f83. ; obj no of segments + obj area increment;
; save obj name:
dl w3 x1+h1+4 ;
ds. w3 i8. ; old obj name:=
dl w3 x1+h1+8 ; obj descr.name;
ds. w3 i9. ;
al w0 0 ; obj descr name := 0;
rs w0 x1+h1+2 ;
; create extended area:
am. (f77.) ;
al w3 +h40 ; get address of <:fp:>;
jd 1<11+64 ; remove fp-process
jl. w2 c8. ; create obj area(w3);
rs. w3 i5. ; name addr:= obj descr.name;
jd 1<11+52 ; create area process(w3);
jd 1<11+8 ; reserve process(w3);
se w0 0 ; if create error
jl. c37. ; then alarm(work area);
; copy to extended area:
al w2 0 ; w0:= 0;
; copy next:
a5: rs. w2 i3. ; first segment:= w2;
al. w3 i1. ; w3:= old object name;
rl. w0 i7. ; w0:= input;
; transfere:
a6: rs. w0 i2. ; operation:= w0;
al. w1 i2. ; w1:= message addr;
jd 1<11+16 ; w2:= send message(w3,w1);
al. w1 i4. ; w1:= answer message;
jd 1<11+18 ; wait answer(w2,w1,w0);
sn w0 1 ; if w0 <> 1
sh w0 (x1) ; or answer message(status) <> 0
jl. a9. ; then goto drum error;
dl. w0 i6. ; w0:= output; w3:= name addr;
se. w0 (i2.) ; if operation <> w0
jl. a6. ; then goto transfere;
; next couple:
rl. w2 i3. ;
al w2 x2+1 ; w2:= first segment +1;
rl. w1 f27. ;
sl w2 (x1+h1+16) ;
jl. 4 ; if w2 <= obj descr. segment count
jl. a5. ; then goto copy next;
\f
; rc 29.06.71 editor i, tape 4, page 14.
; remove old:
al. w3 i1. ; w3:= old obj name;
jd 1<11+48 ; remove entry(w3);
; return after extending:
al w0 1 ; w0:= no characters;
rl. w1 f27. ; w1:= obj descr;
jl. a1. ; goto next block;
; drum error:
a9: al w2 1 ;
ls w2 (0) ;
sn w0 1 ; w2:= 1<w0 +
wa w2 x1 ; if w0 <> 1 then status else 0;
al w1 x3 ;
am. (f77.) ;
jl w3 h7 ; end program(no succes);
z. ; end system 2;
a7: ; special:
; comment: following special bytes can occur:
; <top of line>, <obj bot>, and <comp>;
se w2 g10 ;
jl. a8. ;
; top of line:
al w3 x3+1 ; cur out:= cur out+1;
sn. w3 (f48.) ; if cur out=obj bottom
rl. w3 f47. ; then cur out:=obj top;
rs w0 x1+h2+4 ; obj descr.partial word:= w0;
rl. w2 f45. ;
se. w2 (f44.) ; if cur line <> out line
al w2 x2+1 ; then out line:= out line +1;
ds. w3 f46. ;
dl. w2 f42. ; restore(w1,w2);
jl. (f43.) ; exit(saved return);
a8: se w2 g12 ;
jl. a10. ;
; obj bot:
rl. w3 f47. ; cur out:= obj top;
jl. a2. ; goto next byte;
; composed:
a10: rs. w2 f40. ; save (byte);
al w2 g3 a. 127 ; byte(cur out):= <bs>;
hs w2 x3 ;
al w2 127 ;
la. w2 f40. ; byte:= saved byte and char mask;
jl. a3. ; goto pack;
\f
; rc 29.06.71 editor i, tape 4, page 15.
w.
i1: 0,0,0,0,0 ; old object name
; message address:
i2: 0 ; operation
f85: 0 ; first storage (initialized after loading)
f86: 0 ; last storage ( - - - )
i3: 0 ; first segment
i4:
f87: 0,0,0,0,0,0,0,0 ; answer message:
i5: 0 ; name address:
i6: 5<12 ; output operation
i7: 3<12 ; input operation
i8 = i1+2, i9 = i1+6
e. ; end output line;
c. h57<2 ; if system 2 then begin
c40: ; procedure outblanks
; punching of blank tape on punch
;
; w0 - / destroied
; w1 descriptor / unchanged
; w2 - / destroied
; w3 return / destroied
b. i2
w.
rs. w3 i0. ; save return
rl w2 x1+h0+4 ; get used share
rl. w0 i1. ;
rx w0 x2+6 ; change operation
rs. w0 i1. ; to no parity;
al w0 d17 ; blanks := d17;
rl. w3 f77. ;
al w3 x3+h26 ; save outchar address
rs. w3 i2. ;
al w2 0 ;
jl w3 x3 ; first outchar(o);
al w2 0 ; return: char := 0;
bs. w0 1 ; blanks := blanks - 1;
se w0 0 ; if blanks <> 0 then
jl. (i2.) ; outchar(return);
al w2 0 ;
am. (f77.) ; close up(0);
jl w3 +h34 ;
rl w2 x1+h0+4 ; get used share
rl. w0 i1. ;
rx w0 x2+6 ; restore operation;
rs. w0 i1. ;
jl. (i0.) ; return;
i0: 0 ; saved return;
i1: 5<12 + 4 ; operation;
i2: 0 ; outchar address;
e.
z. ; end system 2;
\f
; rc 17.6.69 editor i, tape 4, page 16.
; definition of instructions
b2: b5 = a5 - b2 ; restore corr
b6 = a6 - b2 ; executed
b7 = a7 - b2 ; executed print
b8 = a8 - b2 ; rel
b9 = a9 - b2 ; set bot
b10 = a10 - b2 ; the line
b11 = a11 - b2 ; search
b12 = a12 - b2 ; ab corr
b13 = a13 - b2 ; copy
b14 = a14 - b2 ; print
b15 = a15 - b2 ; delete line
b16 = a16 - b2 ; delete search
b17 = a17 - b2 ; ad corr print
b18 = a18 - b2 ; repl
b19 = a19 - b2 ; gen
b20 = a20 - b2 ; store line
b21 = a21 - b2 ; reset line
b22 = a22 - b2 ; repeat gen
b23 = a23 - b2 ; gen return
b24 = a24 - b2 ; delete fix
b25 = a25 - b2 ; corr input
b26 = a26 - b2 ; to top
b27 = a27 - b2 ; uphead
b28 = a28 - b2 ; back up
b29 = a29 - b2 ; num
b30 = a30 - b2 ; line
b31 = a31 - b2 ; char
b32 = a32 - b2 ; verify yes
b33 = a33 - b2 ; verify no
b34 = a34 - b2 ; line num printing
b35 = a35 - b2 ; command
b36 = a36 - b2 ; finis ed
b37 = a37 - b2 ; head
b38 = b7 - b6 ;
b39 = a39 - b2 ; source
m.end executor
t.
i.
e. ; end executor;
\f
; rc 27.03.73 editor i, tape 4, page 17.
c30: ; initializing the editor:
; comment: the editor is called by fp with:
; w0: first word of editor
; w1: fp base
; w2: current command top
; w3: current parameter (separator prepended <:edit:>)
;
; the following are performed:
;
; 1. buffers are allocated in core:
; corr line = d4
; source string = remainder/2
; object string = remainder/2
; corr string = d14
; source buffers = d12 * 2
; object buffers = d11 * 2
;
; 2. the fp parameters are examined defining possible sizes for
; object area and correction area.
;
; 3. the object document may be:
; a) nothing (no <equal> in call): a work area is created.
; b) a note: a work area is created and assigned to the note.
; c) something else: the object area is defined already.
; in case a) and b) extention is allowed.
; the object document is connected.
;
; 4. the work area for the correction string is created and con-
; nected.
;
; 5. if current input and current output are the same process and
; there kind is typewriter on-line is true.
; in system 3 on-line is computed in a more complicated manner
;
; 6. a start message is printed and the preprocessor is called.
b. a15,i14 ; begin
w. ;
rs. w1 f77. ; fp base:= w1;
rs. w1 i0. ; save fpbase local;
rs. w3 f78. ; fp current param:= w3;
rl w1 0 ; w1:=
rs. w1 i9. ; first word of editor:= w0;
\f
; rc 1.11.70 editor i, tape 4, page 18.
; 1. buffer allocations:
; object buffer:
al w2 x2-1 ; w2:= current command top -1;
rs w2 x1+f80+h0+2 ; obj descr.last of buffer:= w2;
al w2 x2-1 ; w2:= w2 -1;
rs. w2 f86. ; obj mess.last storage:= w2;
al w2 x2-d11+2 ; w2:=w2 - obj buf no of bytes +2;
rs w2 x1+f81+2 ; obj share .first shared:= w2;
rs. w2 f85. ; obj mess.first storage:= w2;
al w2 x2-1 ; w2:= w2 -1;
rs w2 x1+f80+h0 ; obj descr.base buf area:= w2;
; source buffers:
rs w2 x1+f10+h0+2 ; source descr.last of buffer:= w2;
al w2 x2-d12+1 ; w2:= w2 - source buf no of bytes +1;
rs w2 x1+f12+2 ; source share2.first shared:= w2;
al w2 x2-d12 ; w2:= w2 -source buf no of bytes;
rs w2 x1+f11+2 ; source share 1.first shared:= w2;
al w2 x2-1 ; w2:= w2-1;
rs w2 x1+f10+h0 ; source descr.base buf area:= w2;
; corr string:
rs w2 x1+f2+h0+2 ; corr descr. last of buffer:= w2;
al w2 x2-1 ; w2:= w2 -1;
rs. w2 f50. ; corr bottom:= w2;
al w2 x2-d14+2 ; w2:= w2 - drum track size +2;
rs w2 x1+f7+2 ; corr share.first shared:= w2;
rs. w2 f49. ; corr top:= w2;
al w2 x2-1 ; w2:= w2 -1;
rs w2 x1+f2+h0 ; corr descr.base buf area:= w2;
rs. w2 f48. ; obj bottom:= w2;
al w0 g12 ;
hs w0 x2 ; byte(obj bottom):= <obj bot>;
; corr line:
al. w3 c30. ; w3:= first word of buffer area;
rs. w3 f31. ; corr line addr:= w3;
al w3 x3+d4 ; w3:= w3 + max line length;
rs. w3 f51. ; source top:= w3;
\f
; rc 1.11.70 editor i, tape 4, page 19.
; object string and source string:
ws w3 4 ;
ac w3 x3+d4 ; w3:= w2 - w3 - max line length;
sh w3 d10 ; if w3 <= min no of bytes for object and
jl. a10. ; source then goto no buf space;
ls w3 -2 ;
ls w3 1 ; w3:= w3 // 2;
ws w2 6 ; w2:= w2 - w3;
rs. w2 f47. ; obj top:= w2;
rs. w2 f52. ; source bottom:= w2;
rs. w2 f56. ; saved cur obj:= w2;
rs. w2 f46. ; cur out:= w2;
al w2 x2-d4 ; w2:= w2 -max line length;
rs. w2 f29. ; source line addr:= w2;
rs. w2 f55. ; saved cur source:= w2;
; descriptor addresses:
am. (i0.) ;
al w0 h20 ; in descr := current input descriptor;
rs. w0 f30. ;
am. (i0.) ;
al w0 h21 ; out descr:= current output descriptor;
rs. w0 f26. ;
al w0 x1+f80 ; obj descr:= base obj descr;
rs. w0 f27. ;
al w0 x1+f10 ; source descr:= base source descr;
rs. w0 f28. ;
al w0 x1+f2 ; corr descr:= base corr descr;
rs. w0 f88. ;
am. (i0.) ;
al w0 h25 ; fp inchar address:= fp inchar;
rs. w0 f84. ;
; share descriptors:
al w0 x1+f7 ;
rs w0 x1+f2+h0+4; corr descr.used share:= share descr;
rs w0 x1+f2+h0+6; corr descr. first share:= share descr;
rs w0 x1+f2+h0+8; corr descr.last share:= share descr;
al w0 x1+f12 ; source descr.first share:= share descr 1;
rs w0 x1+f10+h0+4; source descr.used share:= share descr 1;
al w3 x1+f11 ; source descr.last share:= share descr 2;
ds w0 x1+f10+h0+8;
al w0 x1+f81 ; obj descr.first share:= share descr ;
rs w0 x1+f80+h0+4; obj descr.used share:= share descr ;
al w3 x1+f81 ; obj descr.last share:= share descr ;
ds w0 x1+f80+h0+8;
\f
; rc 1.11.70 editor i, tape 4, page 20.
; remove edit area process
am. (i0.) ;
al w3 +h19+h1+2 ; get document name
jd 1<11+64 ; remove process;
; 2. examine fp parameters:
b. d6 ; begin
w. ;
rl. w2 f78. ; w2:= fp current param;
; next param:
d1: ba w2 x2+1 ; w2:= w2 + param size(w2);
bl w0 x2 ; w0:= separator(w2);
sh w0 2 ; if w0 = terminating separator
jl. d5. ; then goto empty source;
d3: se w0 4 ; if w0 <> <spaces>
jl. a11. ; then goto fp param error;
bl w0 x2+1 ; w0:= param size(w2);
se w0 10 ; if w0 <> name size
jl. a11. ; then goto fp param error;
bl w0 x2+10 ; w0:= next separator(w2);
sh w0 4 ; if w0 = <spaces> or terminating separator
jl. d1. ; then goto next param;
se w0 8 ; if w0 <> <dot>
jl. a11. ; then goto fp param error;
rl w0 x2+2 ; w0:= param(w2);
ba w2 x2+1 ; w2:= w2 + param size(w2);
al. w1 f83. ; w1:= address obj no of segments;
sn. w0 (i6.) ; if w0 = <:o:>;
jl. d4. ; then goto store;
am -2048 ;
al. w1 f25.+2048; w1:= address corr no of segments;
se. w0 (i7.) ; if w0 <> <.c:>
jl. a11. ; then goto fp param error;
\f
; rc 29.06.71 editor i, tape 4, page 21.
; store:
d4: bl w0 x2+1 ; w0:= param size(w2);
se w0 4 ; if w0 <> integer size
jl. a11. ; then goto fp param error;
rl w0 x2+2 ;
rs w0 x1 ; word(w1):= param(w2);
jl. d1. ; goto next param;
; end check param;
; empty source:
d5: al w0 g14 ;
am -2048 ;
rl. w2 f29.+2048; byte(source line addr +1):= <first source>;
hs w0 x2+1 ;
e. ; end examine fp param;
; 3. connect object document:
; test any object document:
rl. w1 i0. ; w1:= fp base;
rl. w3 f78. ; w3:= current param;
bl w0 x3 ; if separator(w3) = <equal>
sn w0 6 ; then
jl. a1. ; goto test obj in note;
; no obj document:
h. al w3 , sn w1 x1 ;
w. hs. w3 f73. ; dummy obj:= true;
rl. w3 i12. ;
rs. w3 c10. ;
jl. a5. ; goto create correction area;
; test obj in note:
a1: al w2 x3-8 ; w2:= w3 - param name size;
c. h57<2 ; if system 2 then begin
rl w0 x2 ; w0:= name(w2);
al w3 x1+h52-22 ; w3:= address of fp note 1 - 22;
; step:
a2: al w3 x3+22 ; w3:= w3 + note length;
sn w3 x1+h53 ; if w3 = first after note
jl. a3. ; then goto test object;
se w0 (x3) ; if w0 <> note(w3)
jl. a2. ; then goto step;
\f
; rc 14.09.72 editor i, tape 4, page 22.
;object in note:
al w0 0 ; contents, entry := text;
rs w0 x3+18 ;
a4: al w3 x3+4 ; w3:= address of name in note(w3);
rl w0 x3 ;
se w0 0 ; if note.name <> 0
jl. a6. ; then goto connect object;
rl. w0 i1. ; note(w3):= drum mode and kind;
rs w0 x3-2 ;
; create work:
am -2048 ;
rs. w3 f79.+2048; work obj name:= w3;
jl. w2 c8. ; create obj area;
al w0 0 ;
am -2048 ;
hs. w0 f71.+2048; extend allowed:= true;
z. ; end system 2;
; connect object:
a6: am -2048 ;
rl. w1 f27.+2048; w1:= obj descr;
al w0 1<1+1 ; comment text pref. on disk, one segment;
am. (i0.) ;
jl w3 h28 ; connect output(w0,w1,w2);
se w0 0 ; if connect error
jl. a13. ; then alarm(connect obj);
bz w0 x1+h1+1 ; get document kind;
c. h57<2 ; if system 2 then begin
sn w0 12 ; if kind = punch then
jl. w3 c40. ; outblanks;
jl. a5. ;
a3: al w3 x2 ; test object
am -2048 ;
al. w1 f83.+2048; insert name and tail addresses
jd 1<11+42 ; lookup entry
al w0 0 ; content := text;
rs w0 x1+16 ;
jd 1<11+44 ; change entry(w1,w3);
jl. a6. ;
\f
; rc 76.05.17 editor i, tape 4, page ...22a...
; 4. create correction area:
a5: am. (i9.) ;
al w3 f2+h1+2; w3:= corr descr.name;
am -2000 ;
al. w1 f25.+2000; w1:= address.corr no of segments;
jd 1<11+40 ; create entry(w1,w3);
se w0 0 ; if create error
jl. a12. ; then alarm(no backing storage);
z. ; end system 2;
c. h57<3 ; if system 3 then begin
al w3 0 ; if kind = bs then
sn w0 4 ; extend allowed := true;
hs. w3 f71. ;
al. w1 i12. ; w1 := head and tail address;
am. (i0.) ;
rl w3 +h8 ;
al w3 x3+2 ; w3 := obj name addr;
jd 1<11+76 ; lookup entry head and tail(w1,w3);
rl w3 x1+14 ; move size and document name of
rs. w3 f83. ; object area to tail;
dl w3 x1+18 ;
ds. w3 f83.+4 ;
dl w3 x1+22 ;
ds. w3 f83.+8 ;
bz w0 x1+30 ; if contents>=32 or
sh w0 31 ; contents=4 then
sn w0 4 ; skip move of
jl. 6 ; not used,file,block
dl w3 x1+28 ; move file- and blocknumber;
ds. w3 f83.+14;
dl w0 110
ld w0 5
rs. w3 f83.+10; shortclock;
al w0 2.111 ;
la w0 x1 ; w0 := catkey;
hs. w0 f91. ; perm key := catkey;
dl w1 x1+4 ; w0w1 := entry interval;
ds. w1 f89. ; save (entry interval);
al. w1 f83. ; w1 := tail address;
am. (i0.) ;
rl w3 +h8 ; w3 := address of object name;
al w3 x3+2 ;
jd 1<11+44 ; change entry(w1,w3);
\f
; rc 14.09.72 editor i, tape 4, page 22b.
; in the following it is determined, whether it is possible to
; create an exact copy of the object area (this is used in
; the ...back up... routine)
rl w2 66 ;
rl w3 x2+78 ; w3 := standard upper interval
sl w0 (x2+76) ; if obj lower >= std lower then
jl. a3. ; goto may be inside;
sh w1 x3-1 ; may be outside:
jl. a5. ; if obj upper < std upper then
; interval test is finished;
bl w3 118 ; may be copy: w3 := min global key;
sh w3 0 ; if min global key < 1 then
jl. a4. ; rename is possible;
bs. w3 f91. ; if min global key > permanent key then
sl w3 1 ; interval test is finished;
jl. a5. ;
jl. a4. ; goto rename is possible;
a3: sl w1 x3+1 ; may be inside: if obj upper <= std upper then
jl. a5. ; rename impossible := false;
a4:
h. al w3 , se w1 x1 ; rename is possible:
w. hs. w3 f90. ; rename impossible := false;
a5 = k
z. ; end system 3;
\f
; rc 27.03.73 editor i, tape 4, page 22c.
c.h57<2 ; if system 2 then
; 5. test on-line mode:
al w2 1 ; w2:= false;
rl. w1 i0. ; w1:= fp base;
bz w0 x1+h20+h1+1 ; if current input descr.kind
sn w0 8 ; = typewriter
al w2 0 ; then w2:= true;
dl w0 x1+h20+h1+4 ;
sn w0 (x1+h21+h1+4); if current input descr.name
se w3 (x1+h21+h1+2); <> current output descr.name
al w2 1 ; then w2:= false;
dl w0 x1+h20+h1+8 ;
sn w0 (x1+h21+h1+8);
se w3 (x1+h21+h1+6);
al w2 1 ;
am -2048 ;
hs. w2 f70.+2048 ; on line := w2;
z. ; end system 2
\f
; rc 05.10.78 editor i, tape 4, page 22d.
c.h57<3 ; if system 3 then
; 5. test on-line mode:
b. d2 w.
al w2 1 ; w2:=false;
rl. w1 i0. ; w1:=fp base;
dl w0 x1+h44+2 ; if name(curr.out) <>
sn w3 (x1+h21+h1+2); name(parent)
se w0 (x1+h21+h1+4); then goto s-job;
jl. a14. ;
dl w0 x1+h44+6 ;
sn w3 (x1+h21+h1+6);
se w0 (x1+h21+h1+8);
jl. a14. ;
dl w0 x1+h21+h1+4 ; boss job: if name(curr.in) <>
sn. w3 (d0.) ; <:terminal:>
se. w0 (d1.) ; then goto s-job
jl. a14. ;
dl w0 x1+h21+h1+8 ;
sn. w3 (d2.) ;
se w0 0 ;
jl. a14. ;
al w2 0 ; else on-line := true;
jl. a15. ;
d0: <:ter:>
d1: <:min:>
d2: <:al<0>:>
a14: bz w0 x1+h20+h1+1 ; s-job:
bz w3 x1+h21+h1+1 ;
sn w0 8 ; if kind(curr.in) <> tw
se w3 8 ; or lind(curr.out) <> tw
jl. a15. ; then goto off-line;
dl w0 x1+h20+h1+4 ; if name(curr.in) =
sn w3 (x1+h21+h1+2); name(curr.out) then
se w0 (x1+h21+h1+4); on-line := true
jl. a15. ; else
dl w0 x1+h20+h1+8 ; on-line := false;
al w2 0 ;
sn w3 (x1+h21+h1+6);
se w0 (x1+h21+h1+8);
al w2 1
a15: am -2048 ; set online mode:
hs. w2 f70.+2048 ;
e.z. ; end system 3
\f
; rc 27.03.73 editor i, tape 4, page 23.
; 6. start message and start:
al. w0 i2. ; w0:= <: edit begin:>;
am. (i0.) ;
jl w3 h31-2 ; outtext current(w0);
al w2 10 ;
am. (i0.) ;
jl w3 h33-2 ; outend current(<nl>);
am -2000 ;
jl. c33.+2000; goto start preprocessor;
; initial alarms:
; comment: a message is printed and the fp end program is
; called with w2 = 1, unsuccessful execution;
a13: am i14 ; connect object:
a12: am i10 ; no backing storage:
; fp param error:
a11: am i8 ; text:= text 2; goto print;
; no core:
a10: al. w0 i3. ; text := text 1;
; print:
am. (i0.) ;
jl w3 h31-2 ; outtext current(text);
al w2 10 ;
am. (i0.) ;
jl w3 h33-2 ; outend current(<nl>);
am -2000 ;
rl. w3 f79.+2000;
se w3 0 ; if work area then
jd 1<11+48 ; remove(work area);
al w3 0 ;
am -2000 ;
rs. w3 (f79.+2000);work name:= 0;
al w2 1 ;
am. (i0.) ; end program(1);
jl w3 h7 ;
i0: 0 ; fp base
h.
i1: -1<11 , 4 ; drum mode and kind:
w.
i2: <:edit begin.<0>:>
i3: <:***edit end: no core.<0>:>
i4: <:***edit end: param.<0>:>
i11: <:***edit end: work area.<0>:>
i13: <:***edit end: connect object.<0>:>
i6: <:o:>
i7: <:c:>
i8 = i4-i3
i9: 0 ; first word of editor;
i10 = i11-i4
i12: jl x3 ; instruction for dummy obj in close obj;
i14 = i13-i11
e. ; end initializing the editor
d13 = k - c0 ; editor length
\f
; rc 17.6.69 editor i, tape 4, page 24.
m.end with variable
t.
i.
e. ; end editor block 2;
m.end with global entries
t.
i.
g2=d13
e. ; end editor block 1;
g0:g1: (:g2+511:)>9 ; segm
0, r.4
s2 ; date
0,0 ; file block
2<12+4 ; contents entry
g2 ; length
m.rc 76.05.17 edit
d.
p.<:insertproc:>
l.
e. ; end editor segment;
i.
e. ; end fp block;
t.
\f
▶EOF◀