|
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: 24576 (0x6000)
Types: TextFile
Names: »retlook3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »retlook3tx «
mode list.yes
lookup4tx=edit lookup3tx
; nye modekind abbrev.
; filters as search parameters
; nyt program delete
; base interval parameter til search og delete
; connect output : segm < 2 + key
;
l./cat adm 2/, r/adm 2/adm 2 ...0.../
l./lookup, search/, r/scope/delete, scope/
l./lookup search/, r/scope/delete scope/
l./...06/, r/rc 1976.05.25 / fgs 1988.08.04/
l./b9:/,
l./ds w1 x3+2/, d, i/
am. a50. ;
ds w1 +2 ; and save it in work name;
/, p1
l./ds w1 x3+6/, d, i/
am. a50. ;
ds w1 +6 ; and save it in work name;
/, p1
l./jl. b50./, i/
al. w0 a50. ; w0 := addr (work name);
/, p1
l./al w0 1<1+1/, r/1<1+1/1<2+0/
l./...08/, r/rc 76.05.25 / fgs 1988.08.02/
l./b15:/, l1, i/
sh w1 -2 ; if scope illegal, in max then
al w1 -2 ; scope := illegal, in std;
/, p-2
l./...10/, i#
\f
; fgs 1988.08.02 fp utility, system 3, cat adm 2 ...9a...
;procedure remove entry.
;
;removes the entry addressed by w2
;and returns to link + 2 if removed, to link if not removed
;at return the link b16 is different from zero.
;
;w0 destroyed
;w1 unchanged
;w2 addr of entry unchanged
;w3 link destroyed
;
b. j20 w.
j0: 0 ; saved w0
b66: ds. w3 b16. ; entry: save link, entry;
al w3 x2+6 ; w3 := entry.name;
jd 1<11+48 ; remove entry;
sn w0 0 ; if removed then
jl. j6. ; goto link + 2;
rs. w0 j0. ; save w0;
jl. w3 b26. ; outtext(<:***<prog> <scope>:>,
rl. w0 j0. ; restore w0;
se w0 2 ; if catalog error, document not ready then
jl. j1. ; begin
jl. w3 b43. ; outtext (<:bs device not ready<10>:>);
jl. j5. ; end else to link;
j1: jl. w3 b33. ; outtext (<: :>);
dl. w3 b16. ; restore entry;
al w0 x2+6 ; name := entry.name;
jl. w3 b30. ; outtext (name);
rl. w0 j0. ; restore w0;
se w0 3 ; if not found then
jl. j2. ; begin
jl. w3 b37. ; outtext (<: unknown<10>:>);
jl. j5. ; end else
j2: se w0 4 ; if entry protected then
jl. j3. ; begin
jl. w3 b47. ; outtext (<: entry protected<10>:>);
jl. j5. ; end else
j3: se w0 5 ; if used by another then
jl. j4. ; begin
jl. w3 b46. ; outtext(<: entry in use<10>:>);
jl. j5. ; end else
j4: jl. w3 b45. ; outtext (<: catalog error<10>:>);
j5: jl. (b16.) ; goto link;
j6: am. (b16.) ; return to link + 2:
jl +2 ;
e.
#
l./...11/, r/rc 16.02.72 / fgs 1988.08.02/
l./-2/, r/-2/-4/, l1, i/
; -2: illegal scope, interval contained in std, equals interval in scope
/, p1
l./b. j13/, r/j13/j14/
l./...12/, r/rc 11.02.72 / fgs 1988.08.02/
l./j4:/, i/
/
l./j13:/, l-1, d, i/
al w1 x1+1 ; else
sn. w0 (a12.) ; if int.low <> int in scope.low and
se. w1 (a13.) ; int.up <> int in scope.up then
jl. j11. ; goto inside max else
jl. j14. ; goto inside std, equals int in scope;
/, p1
l./j11:/, r/-2/-4/, i/
j14: am 2 ; inside std, equals int in scope
/, p1
l./...16/, r/82.11.24/88.07.10/
l./a102:/, l1, i/
a104: 0 ; addr of parameter after <scope>).<device>) in search
a105: 0 ; addr of catalog entry in filter algorithm in search
/, p-2
l./a29:/, l1, i/
a30: 4<12+ 4 ; space,integer
a50: 0, r.8 ; work name used in output entry
/, p-1
l./...18/, i#
; dh 1987.05.06 fp system, system 3, cat adm 2 ...17a...
b. a20, b3, c1, d5 w.
;This algorithm enables search to filter the output of catalog entries
;found according to a given scope specification. The filter works on
;the entry name and the document name of an entry.
;
;Syntax (augments):
;------------------
;( )1 ( )*
;(<out file> = ) search <scope spec> (<filter>)
;( )0 ( )0
;
; ( )*
;<filter> ::= <substring>(.<substring>)
; ( )0
;
; ( <generalized name> )
;<substring> ::= ( <name> )
; (<apostrophized name>)
;
;Function:
;---------
; The main catalog is scanned, and a subset of it is listed with an
;output format as for lookup. If an outfile is specified, the list of
;catalog entries is printed on that file, otherwise current output is
;used. Messages from search are always printed on current output.
; If no filters are given, all entries from the main catalog accor-
;ding to the scope spec (see Scope specification) are listed, other-
;wise, the set of catalog entries is further delimited by means of
;filters (see Filter specification below).
;
;Filter specification:
;---------------------
; A filter consists of one or more substrings concatenated by period.
;If a list of filters exists, an entry selected for listing will only
;be listed if either its name or its document name contain all the sub-
;strings of at least one of the filters. The order of the substrings
;in a filter is irrellevant.
; Thus, in a possible list of filters, you may consider space as "or"
;and period as "and", where the precedence of "and" and "or" is as in
;Algol.
\f
; dh 87.05.07 fp system, system 3, cat adm 2 ...17b...
;requirements:
; w0 w1 w2 w3 a104 a105
;
;entry: irr. irr. irr. return item after catalog
; scope spec entry
;
;exit: all registers and variables unchanged.
;
; the procedure returns to return+0 in case of failure
; and to return+2 in case of success.
;
b27: ds. w3 b3. ; save registers
rs. w2 a105. ; save addr entry;
rl. w3 a104. ;
el w2 x3 ; if item after scope spec = end command
sh w2 2 ; then goto letitpass1;
jl. a11. ;
ds. w1 b2. ;
rl. w2 a105. ; save addr entry;
al w2 x2+6 ; name in entry := entry name;
c1: al w3 x3+2 ; repeat <* entry- and document-name *>
ds. w3 d1. ; text part(item) := first item addr + 2;
al w3 10 ; x := 10;
; string := name in entry;
a0: rs. w3 d2. ;
al w1 x3 ; repeat
jl. w3 c0. ; namelength := x;
rl. w3 d2. ; l := takechar(x, string);
al w3 x3-1 ; x := namelength - 1;
sn w1 0 ; until l <> 0;
jl. a0. ;
a1: ; repeat <* all possibillities of filter *>
\f
; dh 87.05.05 fp system, system 3, cat adm 2 ...17c...
;a1: ; repeat <* items in a filter *>
rl. w0 d2. ; j := namelength; <* charcount in an entry *>
a2: rs. w0 d3. ; repeat <* stepping backward through the
; name in the entry *>
al w3 0 ;
jl. a4. ; for i := 0,
a3: rl. w3 d4. ; <*i controls pos in an item *>
al w3 x3+1 ; i+1 while l = k do
se. w1 (d5.) ; begin
jl. a5. ;
a4: rs. w3 d4. ;
am. (d3.) ; k := takechar
al w1 x3 ; (j+i, name in entry);
rl. w2 d0. ;
jl. w3 c0. ;
rs. w1 d5. ;
rl. w1 d4. ; l := takechar
rl. w2 d1. ; (i, item);
jl. w3 c0. ;
sn w1 0 ; if l = 0
jl. a6. ; then goto found;
jl. a3. ; end while loop;
a5: rl. w0 d3. ;
es. w0 1 ; j := j - 1;
sl w0 0 ; until j < 0 <* end backward stepping *>;
jl. a2. ; comment when the loop is exhausted, l<>0;
a6: ;found:
ba w2 x2-1 ; nopass := l <> 0; <* variable kept in w1 *>
rs. w2 d1. ; item := next item;
el w0 x2-2 ; sep := item separator;
se w0 8 ; until sep (item) <> '.'
jl. a7. ;
el w0 x2-1 ; or length (item) = 4 <*integer*>
sh w0 4 ;
jl. a12. ; or nopass <* end items in a filter *>;
al w0 8 ;
sn w1 0 ; comment hereafter either all substrings in a
jl. a1. ; filter have suceeded, or a filter failed;
\f
; dh 87.05.07 fp system, system 3, cat adm 2 ...17d...
a7: sn w1 0 ; if -,nopass <* i.e. a filter suceeded *>
jl. a10. ; then goto letitpass;
a8: se w0 8 ; comment a filter failed, therfore: ;
jl. a9. ; while sep = '.' do
a12: ba w2 x2-1 ; begin
el w0 x2-2 ; item := next item; sep := item separator;
jl. a8. ; end;
a9: rs. w2 d1. ; comment we may now examine the next filter;
sl w0 4 ; until sep = end command;
jl. a1. ; comment all filters have failed on this name;
rl. w2 a105. ; name in entry := document name;
al w2 x2+16 ; item := item after scope spec;
rl. w3 a104. ;
se. w2 (d0.) ; until document name tested once before;
jl. c1. ; comment the names have been tested with all fltrs;
dl. w1 b2. ;failure:
dl. w3 b3. ; restore registers;
jl x3 ; return failure;
a10: dl. w1 b2. ;letitpass:
a11: dl. w3 b3. ;letitpass1: restore registers;
jl x3+2 ; return success;
\f
; dh 87.05.05 fp system, system 3, cat adm 2 ...17e...
c0: ;subprocedure takechar(pos, string);
; call: w0: -; w1: pos; w2: string; w3: return
al w0 0 ; exit: w0: -; w1: char; w2: unch; w3: unch
wd. w1 b0. ; addr := pos // 3;
am x1 ; subpos := pos mod 3;
am x1 ;
rl w1 x2 ; substring := word(2*addr + string);
ls w0 3 ;
am (0) ; char := substring shift(subpos*8 -16)
ls w1 -16 ; extract 7;
la. w1 b1. ;
jl x3 ; return;
b0: 3 ; constant 3 <* chars per word *>
b1: 8.177 ; constant: last 7 bits;
0, b2: 0, 0, b3: 0 ; room for registers;
d0: 0 ; addr of name in an entry;
d1: 0 ; addr of text part of an item;
d2: 0 ; namelength, i.e. length of name part in an entry
d3: 0 ; var: j <* stepping through name in an entry *>
d4: 0 ; var: i <* stepping through an item *>
d5: 0 ; var: k <* char from an entry *>
e. ; end block
#
l./...18/, l./a62:/, l1, i/
i0: jl. b0. ; stepping stone:
i2: jl. b2. ; -
i3: jl. b3. ; -
i4: jl. b4. ; -
/, p-4
l./...19/, r/84.06.18/88.05.06/
l./<:mtlh:>/, d./<:mthl:>/, i#
<:mt62:> , 1<23+ 0<12+18; mt, low speed, 6250 bpi , odd parity
<:mte:>,0 , 1<23+ 2<12+18; , - - , high density, even -
<:mt16:> , 1<23+ 4<12+18; , - - , 1600 bpi , odd -
<:nrze:> , 1<23+ 6<12+18; , - - , low density, even -
<:mt32:> , 1<23+ 8<12+18; , - - , 3200 bpi , odd -
<:mt08:> , 1<23+ 12<12+18; , - - , 800 bpi , - -
<:mthh:> , 1<23+128<12+18; , high - , high density, odd -
<:mthl:> , 1<23+132<12+18; , - - , low - , - -
#, p1
l./...22/, r/rc 78.04.11 / fgs 1988.07.08/
l./c3:/, l./jl. w3 b15./, i/
jl. w3 b27. ; test filters;
jl. c4. ; if failure then goto step entry;
/, p-2
l./b64:/, i#
\f
; fgs 1988.12.19 fp utility, system 3, cat adm 2 ...23...
;the program delete
b. c6 w.
g7: jl. w1 b0. ; start: initialize program;
jl. w3 b8. ; if left side then connect;
rs. w1 a16. ; save output zone address;
jl. w3 b22. ; read scope parameter;
sn w3 8 ; if scope = system then
jl. b14. ; goto scope error;
sl w3 10 ; if scope=own
jl. c5. ; then goto change criteria;
c1: jl. w3 b17. ; prepare cat. scan;
jl. w3 b19. ; start cat. scan;
c2: jl. w3 b23. ; check entry: find entry scope;
c3: se. w1 (a14.) ; if entry(scope) <> actual
jl. c4. ; then goto step entry;
jl. w3 b24. ; test bs device spec.;
jl. w3 b27. ; test filters;
jl. c4. ; if failure then goto step entry;
jl. w3 b15. ; ok: output entry;
dl w1 x2+4 ; interval := entry.interval;
al. w3 a15. ; w3 := addr <::>; <*own process*>
jd 1<11+72 ; set catbase;
jl. w3 b66. ; remove entry;
jl. c0. ; if not removed then goto reset catbase;
c0: jl. w3 i3. ; reset catbase;
c4: jl. w3 b21. ; step entry: next entry;
jl. c2. ; more in buf: goto check entry;
jl. w3 b20. ; buf empty: input cat. segments;
jl. c2. ; more in cat: goto check entry;
rl. w0 b16. ; end search:
se w0 0 ; if some output
jl. b2. ; then goto end program;
jl. w3 b26. ; error text:
jl. w3 b40. ; outtext(***<prog.name> <scope>
jl. b2. ; no entries found); goto end prog;
c5: rl. w0 c6. ; change criteria:
rs. w0 c3. ; change crit. to: if entry
jl. c1. ; not visible ;
c6: sl w1 8 ; new instruction
e. ; end program delete
\f
; fgs 1988.07.08 fp utility, system 3, cat adm 2 ...24...
#
l1,
l./...22a/, r/22a/25/
l./...22b/, r/22b/26/
l./...22c/, r/22c/27/
l./...23/ , r/23/28/
l./a95=g4/, l1, i/
jl. b11. ; stepping stone for b11:
b11 = k - 2 ;
jl. b14. ; stepping stone for b14:
b14 = k - 2 ;
jl. b26. ; stepping stone for b26:
b26 = k - 2 ;
/, p-3
l./...24/, r/rc 28.02.72 / fgs 1988.07.10/, r/24/29/
l./;a12-a13/,
l-1, r/temp/basepair temp/
l1, r/stand/base stand/
l1, r/0/-2 0/
l./b. j12/, r/j12/j20/
l./b22:/, l2, r/b2./i2./
l2, i/
al w3 x2+10 ;
rs. w3 a104. ; save addr param after <scope>;
/, p-2
l./jl. b14./, r/b14./j13./, r/scope error/maybe interval/
l./ls w3 -2/, i/
\f
; fgs 1988.07.08 fp utility, system 3, cat adm 2 ...30...
/
l./j5:/, d, i/
j5: rl. w0 (a104.) ; look for bs device spec:
/, p1
l./...25/, r/rc 10.02.72 / fgs 1988.07.10/, r/25/31/
l./sl. w0 (a29.)/, i/
al w3 x2+10 ;
rs. w3 a104. ; save addr param after <scope>.<device>;
/, p-2
l./...26/, r/rc 15.02.72 / fgs 1988.07.10/, r/26/32/
l./jl. b2./, r/b2./i2./
l./e. ;end procedure read scope parameter/, i/
j13: se. w0 (a30.) ; if del, kind <> space, integer then
jl. b14. ; goto scope error;
rl w1 x2+2 ; int in scope.low := lower :=
rs. w1 a12. ; param;
jl. w3 b11. ; next param;
jl. i2. ; if end list then end program;
se. w0 (a29.) ; if del, kind <> point, integer then
jl. b14. ; goto scope error;
rl w1 x2+2 ; int in scope.up := upper :=
rs. w1 a13. ; param;
al w3 x2+4 ;
rs. w3 a104. ; save addr param after <interval>;
rl. w0 a12. ;
al w1 x1+1 ;
sl w0 x1 ; if lower > upper then
jl. b14. ; goto scope error;
sh. w0 (a6.) ; if lower > std.lower
sh. w1 (a7.) ; or upper < std.upper then
jl. j14. ; goto check contained in std;
jl. b14. ; else
; goto scope error;
j14: al w1 x1-2 ; check contained in std:
sl. w0 (a6.) ; if lower < std.lower
sl. w1 (a7.) ; or upper > std.upper then
jl. b14. ; goto scope error;
al w3 -2 ;
rs. w3 a14. ; save value;
jl. j5. ; goto look for bs dev. spec;
/
l./;call error:/, i/
\f
; fgs 1988.07.08 fp utility, system 3, cat adm 2 ...33...
/
l./jl. b2./, r/b2./i2./
l./jl. b2./, r/b2./i2./
l./ ...27/, r/rc 78.04.10 / fgs 1988.07.10/, r/27/34/
l./jl. w1 b0/, r/b0./i0./
l./jl. b2./, r/b2./i2./
l./jl. w3 b4./, r/b4./i4./
l./c3:/, d./jl. c0./, i/
c3: jl. w3 b66. ; remove entry;
jl. c0. ; if not removed then goto set catbase;
jl. c1. ; if removed then goto next clear ;
/, p-3
l./...28/, r/82.11.24/88.07.10/, r/28/35/
l./jl. w3 b3./, r/b3/i3/
l./jl. w3 b4./, r/b4./i4./
l./...29/, r/29/36/
l./sl w3 8/, r/if/or/, i/
sl w3 0 ; if scope < 0
/, p1
l./c5:/, d, i/
c5: am -2000 ; next scope:
jl. w3 b11.+2000 ; next param;
/, p-3
l./...30/, r/30/37/
l./...31/, r/87.03.13/88.07.10/, r/31/38/
l./jl. w3 b3./, r/b3./i3./
l./jl. w3 b3./, r/b3./i3./
l./am -2048/, d
r/b3./i3./, r/+2048/ /
l./...32/, r/rc 79.08.30 / fgs 1988.07.10/, r/32/39/
l./am -2048/, d
r/b3./i3./, r/+2048/ /
l./cat adm 2 tails/, l./rc 19/, r/87.03.13/88.12.19/, r/m.rc/m. rc/
l./m. look/, r/m. look/m. look/, r/clear/clear,delete/
l./g0:/, l-1, d./<:insertproc/, i/
w.
g0: (:g2+511:) > 9 ; no of segments
0,r.4 ;
s2 ; month year
0,r.2 ;
2<12+g4-g3 ; entry lookup
g2 ;
1<23+4 ; kind = bs
0,r.4 ;
s2 ; month year
0,r.2 ;
2<12+g5-g3 ; entry search
g2 ;
1<23+4 ; kind = bs
0,r.4 ;
s2 ; month year
0,r.2 ;
2<12+g6-g3 ; entry clear
g2 ;
1<23+4 ; kind = bs
0,r.4 ;
s2 ; month year
0,r.2 ;
2<12+g7-g3 ; entry delete
g2 ;
g1: 1<23+4 ; kind = bs
0,r.4 ;
s2 ; month year
0,r.2 ;
2<12+g10-g3 ; entry scope
g2 ;
d.
p.<:insertproc:>
/
f
end
▶EOF◀