|
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: 64512 (0xfc00)
Types: TextFile
Names: »uti23«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦f8e4b63af⟧ »trcfput«
└─⟦this⟧
\f
;rc 25.05.73 fp utility, system 3, cat adm 2
; the catalog administration text 2 contains the programs
; lookup, search, clear, scope
; the text is assembled by a call of the slang assembler
; of the following type:
; (lookup=slang text
; lookup search clear scope)
;rc 23.02.72 fp utility, cat adm 2 ...01...
b. g15 w. ; outer block for insertproc
d.
p.<:fpnames:>
l.
s. a200, b200, i100
w.
k=h55+10000
g3=k
a0 ; length
;procedure init program
;
;called just after entry nb: link w1
;
b0: ds. w3 a2. ; save first core,pointer;
al w3 x3+2 ;
rs. w3 a3. ;
bz w2 x3-2 ;
se w2 6 ; return:=
am 2 ; if delim <> 6 then link+2
al w3 x1 ; else link;
rl w2 66 ; w2:=process descr address;
dl w1 x2+70 ;
ds. w1 a5. ; move catbase;
dl w1 x2+78 ;
ds. w1 a7. ; move standard;
dl. w1 h58.+10000 ;
ds. w1 a9. ; move user;
dl w1 x2+74 ; move max;
ds. w1 a11. ;
al. w1 h21.+10000 ; w1:=addr of curr out zone;
jl x3 ; goto return;
\f
;rc 16.04.72 fp utility, system 3, cat adm 2 ...02...
;end program
;
b. j3 w.
b2: jl. w3 b3. ; reestablish catbase;
al. w3 a74. ; remove process
jd 1<11+64 ; (<:catalog:>);
rl. w1 a16. ; look for sec. output:
se w1 0 ; if no sec zone
sn. w1 h21.+10000 ; or zone = cur out
jl. j1. ; then goto set ok;
bz w3 x1+h1+1 ; terminate sec out:
se w3 4 ; char := if kind=bs
sn w3 18 ; or if kind=mt then em
am 25 ; else
al w2 0 ; null
jl. w3 h34.+10000 ; close up (char);
jl. w3 h79.+10000 ; terminate zone;
bz w0 x1+h1+1 ; test bs:
sn w0 4 ; if kind = bs
jl. j2. ; then goto cut down;
j3: rl. w3 h8.+10000 ; set content:
al w3 x3+2 ;
al. w1 a87. ; lookup entry(outfile);
jd 1<11+42 ;
al w0 0 ;
rs. w0 a94. ; content := text;
jd 1<11+44 ; change entry(outfile);
j1: am. (a22.) ; set ok:
se w1 x1 ; w2 :=
am 1 ; if not ok then 1
al w2 0 ; else 0;
b10: jl. h7.+10000 ; goto fp end program;
j2: al w3 x1+h1+2 ; cut down:
al. w1 a87. ;
jd 1<11+42 ; lookup entry(outfile);
rl w0 x3+14 ; size(tail) :=
rs. w0 a87. ; segment count;
jd 1<11+44 ; change entry;
jl. j3. ; goto set content;
e.
\f
;rc 16.02.72 fp utility, system 3, cat adm 2 ...03...
;procedure output parameters
;
;searches through the fp command stack for a parameter with
;delim = space or end list while listing the parameters
;found. when such a parameter or end list is found the
;procedure returns.
;
; call return
;w0 destroyed
;w1 destroyed
;w2 addr of param destroyed
;w3 link destroyed
;
b. j2 w.
b4: rs. w3 j0. ; save link;
j1: ; output parameter:
bz w1 x2 ; w1:=delim;
jl. w3 x1+b29. ; outtext(delim);
bz w1 x2+1 ; w1:=kind;
al. w3 j2. ; return := j2 ;
al w0 x2+2 ; w0:=addr(param);
se w1 4 ; if kind <> integer
jl. h31.-2+10000 ; then outtext(param);
rl w0 (0) ; else
jl. w3 h32.-2+10000 ; outinteger(param);
0<23+32<12+1 ;
j2: ba w2 x2+1 ; w2:=next param;
rl w0 x2 ;
sh. w0 (a23.) ; if delim not point or =
jl. (j0.) ; then return;
jl. j1. ; goto output parameter;
j0: 0 ; saved link
e.
\f
;rc 10.02.72 fp utility, system 3, cat adm 2 ...04...
;various output on special output
;
;as a rule the following holds:
;
; at call at return
;w0 (add of text, int.) destroyed
;w1 zone address
;w2 unchanged
;w3 link destroyed
;
b. j4 w.
j0: 0 ; saved link
j1: 0 ; saved integer or address
;
;various outtexts:
; text:
b63: am i63 ; <: ; :>
b62: am i62 ; <:<10> ; :>
b61: am i61 ; <:<10>:>
b60: am i60 ; <:***:> the entries b60 - b54
b59: am i59 ; <:temp:> should be consecutive
b58: am i58 ; <:login:>
b57: am i57 ; <:user:>
b56: am i56 ; <:project:>
b55: am i55 ; <:system:>
b54: am i54 ; <:***:>
b53: am i53 ; <:=set:>
b52: am i52 ; <:.:> this two entries
b51: al. w0 a51. ; <: :> should be consecutive
b50: rl. w1 a16. ; w1:=zone address;
jl. h31.+10000 ; outtext; (direct return);
;procedure output signed integer
;
b5: ds. w0 j1. ; save integer and link;
jl. j2. ; goto out space;
\f
;rc 02.02.72 fp utility, system 3, cat adm 2 ...05...
;out integer or byte.byte.
;
b6: ds. w0 j1. ; save integer and link;
bz w3 1 ; w3:=right byte;
sn w0 x3 ; if integer = right byte
jl. j2. ; then goto out space;
rs. w3 j1. ; next integer := right byte;
rl. w1 a16. ; w1 := zone address;
bz w0 0 ;
jl. w3 h32.+10000 ; outinteger(left byte);
1<23+32<12+1 ;
am -2 ; modify next to out point;
j2: jl. w3 b51. ; outtext(space);
rl. w0 j1. ;
jl. w3 h32.+10000 ; outinteger(integer);
1<23+ 0<12+1 ;
jl. (j0.) ; return;
;outtext preceeded with a space
;
b7: ds. w0 j1. ; save addr and link
jl. w3 b51. ; outtext(space);
dl. w0 j1. ;
jl. b50. ; outtext(text);
\f
;rc 1976.05.25 fp utility, system 3, cat adm 2 ...06...
;output name with spaces
;
b9: ds. w0 j1. ;
rl. w3 j1. ;
dl w1 x3+2 ;
lo. w0 j3. ; add spaces to
lo. w1 j3. ; first half of
ds w1 x3+2 ; name
dl w1 x3+6 ;
lo. w0 j3. ; add spaces to
lo. w1 j4. ; second half of
ds w1 x3+6 ; name;
dl. w0 j1. ;
jl. b50. ; outtext(name);
j3: <:<32><32><32>:>
j4: <:<32><32><0>:>
;connect special output zone
;
b8: rs. w3 j0. ;
jl. w3 h29.-4+10000 ; stack curr in;
rl. w2 a3. ;
al w2 x2-10 ; w2:=addr(outfile name);
al w0 1<1+1 ;
jl. w3 h28.+10000 ; connect cur in (outfile);
sn w0 0 ; if ok
jl. b1. ; then return;
jl. w3 b12. ; troubles: outtext(<name>
jl. w3 b38. ; connect
rl. w2 a3. ;
al w0 x2-10 ;
jl. w3 b30. ; <outfile>
jl. w3 b32. ; <nl> );
jl. (j0.) ;
b1: bl w0 x1+h1+1 ;
sn w0 4 ; if -,bs and
jl. 6 ; -,mt then
se w0 18 ; return;
jl. (j0.) ;
al. w1 h54.+10000 ; w1:=lookup area;
rl. w2 a3.
al w2 x2-10
jl. w3 b65. ; prepare output
al. w1 h20.+10000 ; w1:=cur in
jl. (j0.) ; return; comment: now w1
; points to cur out zone;
e. ; end of secondary out procedures
\f
;rc 15.02.72 fp utility, system 3, cat adm 2 ...07...
;scope error
;
;outputs the error text
; ***<prog name> <parameter> illegal scope<10>
;and exits to end program
;
b14: jl. w3 b26. ; outtext(***<prog> <scope>);
jl. w3 b36. ; outtext(illegal scope);
jl. b2. ; goto end program;
;procedure output
; ***<prog.name> <scope parameter>
;
; call return
;w0 destroyed
;w1 destroyed
;w2 destroyed
;w3 link destroyed
;
b. j1 w.
j0: 0 ; saved link
b26: rs. w3 j0. ; start: save link;
jl. w3 b12. ; outtext(***<prog.name>);
rl. w2 a102. ;
jl. w3 b4. ; outtext(<scope param>);
jl. (j0.) ; return;
e.
;procedure reestablish catalog base
;
b. j0 w.
b3: rs. w3 j0. ;
dl. w1 a5. ;
al. w3 a15. ;
jd 1<11+72 ; set catbase back;
jl. (j0.) ; return;
j0: 0 ; saved link
e.
;procedure next parameter
;
;forwards the pointer a2 to the next parameter in the
;command stack. if end list the return is to link
;else to link + 2.
;
;w0 delim,kind
;w1 unchanged
;w2 pointer
;w3 link destroyed
;
;the pointer points to the item preeceding the parameter.
b11: rl. w2 a2. ;
ba w2 x2+1 ; step pointer;
rl w0 x2 ; w0:=del,kind;
sh. w0 (a25.) ; if end list
jl x3 ; then goto link
rs. w2 a2. ; else store pointer
jl x3+2 ; and goto link+2;
\f
;rc 76.05.25 fp utility, system 3, cat adm 2 ...08...
;procedure output entry.
;
;outputs the entry addressed by w2.
;at return the link b16 is different from zero.
;
;w0 destroyed
;w1 scope value zone address
;w2 addr of entry unchanged
;w3 link destroyed
;
b. j20 w.
j0: 0 ; scope value
j1: 0 ; entry address
b16: 0 ; saved link
b15: ds. w3 b16. ; save link,entry address;
rs. w1 j0. ; save scope value;
al w0 x2+6 ; output name
jl. w3 b9. ; with spaces;
jl. w3 b53. ; output ( =set );
rl w0 x2+14 ; w0:=kind;
al. w3 j4. ; return:=out.doc.name;
sl w0 0 ; if kind >= 0 then
jl. b5. ; outinteger(kind);
al. w1 a26. ; search mode.kind table:
; w1:=first of table;
j2: sn w0 (x1+4) ; if kind = table(w1)
jl. j3. ; then goto outtext.kind ;
al w1 x1+6 ; index:=index+6;
se. w1 a27. ; if not end table then
jl. j2. ; compare again;
jl. b6. ; outbyte.byte(kind);
j3: al w0 x1 ; outtext.kind:
jl. b7. ; outtext(kind);
j5: 1<16 ;
j4: al. w3 j8. ; doc.name: return:=out.date;
rl w0 x2+16 ;
sh. w0 (j5.) ; if first word of name
jl. b6. ; is < 1<16 then outbyte(name);
al w0 x2+16 ;
jl. b7. ; outtext(doc.name);
j8: bz w0 x2+30 ; outdate:
se w0 4 ; if contents=4
sl w0 32 ; or contents>=32
jl. j6. ; then goto outrest;
rl w0 x2+24 ; if date=0
sn w0 0 ; then
jl. j6. ; goto outrest;
jl. w3 b64. ; outdate;
am 2 ;
\f
;rc 10.02.72 fp utility, system 3, cat adm 2 ...09...
j6: al w2 22 ; out rest:
j7: al w2 x2+2 ; next:
am. (j1.) ;
rl w0 x2 ; w0:=parameter;
jl. w3 b6. ; outbyte.byte(parameter);
sh w2 30 ; if more parameters
jl. j7. ; then output again;
; scope comment: outtext(<: ; :>);
jl. w3 b63. ;
am. (j0.) ; output
jl. w3 b59. ; scope text;
rl. w2 j1. ; look for permanent in aux catalog:
rl w0 x2+14 ; if kind >= 0 then
sl w0 0
jl. j13. ; goto output head;
bz w2 x2 ; w2 := first slice;
al w2 x2-1<11 ;
sh w2 -1 ; if not in any aux cat
jl. j13. ; then goto out head;
am (92) ;
am (x2) ;
al w2 -18 ; w2:=address of bs dev name;
dl w1 x2+2 ; move name
ds. w1 j14. ; to
dl w1 x2+6 ; own
ds. w1 j15. ; area;
jl. w3 b52. ; outtext(<:.:>);
al. w0 j16. ;
jl. w3 b50. ; outtext(<device name>);
; out head:
j13: jl. w3 b62. ; outtext(<:<10> ; :>);
rl. w2 j1. ;
bz w0 x2 ;
jl. w3 b5. ; outinteger(<first slice>);
bz w0 x2+1 ;
ls w0 -3 ;
jl. w3 b5. ; outinteger(<name key>);
bz w0 x2+1 ;
la. w0 a28. ;
jl. w3 b5. ; outinteger(<cat key>);
rl w0 x2+2 ;
jl. w3 b5. ; outinteger(<interval lower>);
rl w0 x2+4 ;
jl. w3 b5. ; outinteger(<interval upper>);
jl. w3 b61. ; outtext(nl);
jl. (b16.) ; return to link;
j16: 0 ; device name
j14: 0 ;
0 ;
j15: 0 ;
e.
\f
;rc 25.05.73 fp utility, system 3, cat adm 2 ...10...
;error text output procedures
;
;as a rule:
; at call at return
;w0 add of text or integer destroyed
;w1 cur out zone
;w2 unchanged
;w3 link destroyed
;error texts:
b48: am i48 ; <: error<10>:>
b47: am i47 ; <: protected<10>:>
b46: am i46 ; <: entry in use<10>:>
b45: am i45 ; <: catalog error<10>:>
b44: am i44 ; <: change bs device impossible<10>:>
b43: am i43 ; <: bs device not ready<10>:>
b42: am i42 ; <: no resources<10>:>
b41: am i41 ; <: call<10>:>
b40: am i40 ; <: no entries found<10>:>
b39: am i39 ; <: bs device unknown<10>:>
b38: am i38 ; <: connect :>
b37: am i37 ; <: unknown<10>:>
b36: am i36 ; <: illegal scope<10>:>
b35: am i35 ; <: param :>
b34: am i34 ; <:***:>
b33: am i33 ; <: :>
b32: am i32 ; <:<10>:>
b31: al. w0 a31. ; <:.:>
b29=b33-4 ; cf ...03...
;outtext on current out
b30: jl. h31.-2+10000 ;
;outtext program name and set ok to sorry
;
b12: rs. w3 a22. ; ok:=return;
jl. w3 b3. ; reestablish catbase;
jl. w3 b34. ; outtext ( ***
rl. w0 a3. ;
rl. w3 a22. ;
jl. b30. ; <program name> );
;parametererror.
;outputs the text
; ***<prog name> param <parameter><10>
;and exits to end program
b13: jl. w3 b12. ; outtext(***<prog name>);
jl. w3 b35. ; outtext(param);
rl. w2 a2. ; w2:=pointer;
jl. w3 b4. ; output parameter;
jl. w3 b32. ; output a nl;
jl. b2. ; goto end program;
\f
;rc 16.02.72 fp utility, system 3, cat adm 2 ...11...
;procedure find entry scope
;
;finds the scope of the entry addressed by w2
;(w2 should point to first slice). the scope value is given
;according to the following code:
;
; -2: illegal scope, interval contained in max
; 0: temp
; 2: login
; 4: user
; 6: project
; 8: system
; 10: illegal scope, interval not in max
; 12: not visible
;
; entry return
;w0 destroyed
;w1 scope value
;w2 addr of entry unchanged
;w3 link destroyed
;
b. j13 w.
b23: rs. w3 j0. ; start: save link;
rl w1 x2 ; if unused place in catalog
sn w1 -1 ; then goto
jl. j12. ; not visible;
dl w1 x2+4 ; check interval:
al w1 x1+1 ; check contains standard:
sh. w0 (a6.) ; if int.low > low.stand
sh. w1 (a7.) ; or int.upp < upp.stand
jl. j4. ; then goto check contained in stand;
al w1 x1-1 ;
bz w3 x2+1 ;
la. w3 a28. ; w3:=cat.key;
sn. w0 (a6.) ; if interval
se. w1 (a7.) ; <> standard then
jl. j1. ; goto compare with user;
sl w3 3 ; interval is standard: if key>=3
jl. j1. ; then goto compare with user;
se w3 2 ; if key = 0 or 1
jl. j10. ; then goto temp
jl. j9. ; else goto login;
j1: sn. w0 (a8.) ; compare with user:
se. w1 (a9.) ; if interval <> user
jl. j2. ; then goto compare with max;
sn w3 3 ; if key = 3
jl. j8. ; then goto user
jl. j11. ; else goto inside max;
\f
;rc 11.02.72 fp utility, system 3, cat adm 2 ...12...
;find entry scope continued:
j2: sn. w0 (a10.) ; compare with max:
se. w1 (a11.) ; if interval <> max
jl. j3. ; then goto test contains max;
sn w3 3 ; if key=3 then
jl. j7. ; goto project else
jl. j11. ; else goto inside max;
j3: al w1 x1+1 ; test contains max:
sh. w0 (a10.) ; if int.low > max.low
sh. w1 (a11.) ; or int.upp < max.upp
jl. j13. ; then goto test inside max;
sn w3 3 ; if key = 3
jl. j6. ; then goto system;
jl. j5. ; else goto not in max;
j4: al w1 x1-2 ; check contained in standard:
sl. w0 (a6.) ; if int.low < stand.low
sl. w1 (a7.) ; or int.upp > stand.upp
jl. j12. ; then goto not visible
jl. j11. ; else goto inside max
j13: al w1 x1-1 ; test inside max:
sl. w0 (a10.) ; if int.low < max.low
sl. w1 (a11.) ; or int.upp > max.upp
jl. j5. ; then goto not in max
jl. j11. ; else goto inside max;
j12: am 2 ; not visible
j5: am 2 ; not in max
j6: am 2 ; system
j7: am 2 ; project
j8: am 2 ; user
j9: am 2 ; login
j10: am 2 ; temp
j11: al w1 -2 ; inside max
jl. (j0.) ; return to link;
j0: 0 ; saved link;
e.
\f
;rc 11.02.72 fp utility, system 3, cat adm 2 ...13...
;catalog scan procedures
;
b. j3 w.
;procedure prepare catalog scan
;
;the area process is created, the input message is prepared
;and the length of the catalog is found.
;
;
;w0 destroyed
;w1 destroyed
;w2 length of catalog
;w3 link destroyed
;
j1: 0 ; link
b17: rs. w3 j1. ;
al. w0 a100. ; w0:=first free core;
rl. w1 a1. ; w1 :=
al w1 x1-2 ; last freee core;
ds. w1 a77. ; set first and last;
al. w3 a74. ;
jd 1<11+52 ; create area process(<:catalog:>);
se w0 0 ; if not created then
jl. b28. ; goto resource trouble;
jd 1<11+4 ; process description(<:catalog:>);
am (0) ;
rl w2 18 ; w2 := length of catalog;
rs. w2 a70. ; save length of catalog;
jl. (j1.) ; return;
;procedure start catalog scan
;
;the scan may be started either at the beginning of the catalog
;or at the segment no given by w2.
;
b19: al w2 0 ; w2:= 0;
b18: rs. w2 a78. ; segment := w2;
rl. w2 a70. ; segments left :=
rs. w2 a71. ; length of catalog;
\f
;rc 16.02.72 fp utility, system 3, cat adm 2 ...14...
;procedure input catalog segments
;
;inputs the next segments of the catalog to the buffer
;if any segments are left. if some segments are read
;the return is to link - if no segments are read the
;return is to link+2.
;
b20: rl. w2 a71. ; if segments left
sh w2 0 ; is <= 0
jl x3+2 ; then goto link+2;
rs. w3 j1. ; save link;
al. w3 a74. ; start transport:
j2: al. w1 a75. ;
jd 1<11+16 ; send message
al. w1 a79. ; check transport:
jd 1<11+18 ; wait answer;
sn w0 2 ; if reserved
jl. j2. ; then repeat;
bz w3 x1 ;
sn w0 1 ; if result <> norm.answ.
se w3 0 ; or any status bit <> 0
jl. j3. ; then goto catalog error;
rl. w2 a71. ;
rl w3 x1+2 ;
ls w3 -9 ; seg.trans := bytes // 512 ;
rl. w0 a78. ; segment no :=
wa w0 6 ; segment no
sl. w0 (a70.) ; + seg.transf
ws. w0 a70. ; modulo length of
rs. w0 a78. ; catalog;
ws w2 6 ; seg.left :=
rs. w2 a71. ; seg.left - seg.trans ;
sh w2 -1 ; if seg.left < 0
wa w3 4 ; seg.trans:=seg.trans+seg.left ;
ls w3 9 ; buf.length:=seg.trans*512 ;
rl. w2 a76. ; entry.adr:=first.buf;
al w0 x2+509 ; last.in.seg:=first.buf+509;
wa w3 4 ; last.in.buf:=first.in.buf
ds. w0 a73. ; + buf.length;
jl. (j1.) ; return;
;catalog error:
j3: al w2 1 ;
ls w2 (0) ;
lo w2 x1 ; w2:=log.status;
al. w1 a74. ; w1:=addr of <:catalog:> ;
jl. b10. ; goto end ærogram;
\f
;rc 08.02.72 fp utility, system 3, cat adm 2 ...15...
;procedure next entry
;
;forwards the entry address in w2 to the next entry in the
;buffer. if end buffer is met the return is to link + 2
;else to link.
;
; unchanged
;w1 unchanged
;w2 entry address new entry address
;w3 link unchanged
;
b21: al w2 x2+34 ; entry.adr:=entry.adr+entry.length;
sh. w2 (a73.) ; if entry <= last.seg
jl x3 ; then return;
al w2 x2+511 ; step segment: skip last word;
rs. w2 a73. ; last on segment :=
al w2 x2-509 ; entry address + 509 ;
sl. w2 (a72.) ; if buf exhausted
jl x3+2 ; then goto link+2
jl x3 ; else goto link;
e.
\f
;rc 17.02.72 fp utility, system 3, cat adm 2 ...16...
;working locations:
a1: 0 ; last available core
a2: 0 ; param pointer in fp stack
a3: 0 ; prog. name address
a4: 0 ;
a5: 0 ; catalog base
a6: 0 ;
a7: 0 ; standard interval
a8: 0 ;
a9: 0 ; user interval
a10: 0 ;
a11: 0 ; max interval
a12: 0 ;
a13: 0 ; interval in scope
a101: 0 ; aux cat reference in scope
a102: 0 ; address of scope parameter
a14: 0 ; value of scope
a15: 0 ; a zero
a16: 0 ; output zone address
a17: 0 ; name area no 1
a18: 0 ; used for device name in scope in
a19: 0 ; the programs: search, scope, clear
a20: 0
a21: 0 ; for name table address
a22: 0 ; ok status
a23: 4<12+10 ; space,name
a24: 8<12+10 ; point,name
a25: 4<12-1 ; test end list
a28: 2.111 ; mask for cat key
a29: 8<12+ 4 ; point,integer
;the next are used in catalog scan:
a70: 0 ; catalog length
a71: 0 ; segments left
a72: 0 ; last in buffer
a73: 0 ; last on segment
a74: <:catalog:>,0,0
a75: 3<12 ; message : op = input
a76: 0 ; first
a77: 0 ; last
a78: 0 ; segment
a79: 0,r.8 ; answer
\f
;rc 09.02.72 fp utility, system 3, cat adm 2 ...17...
;procedure test bs device specifications
;
;the entry addressed by w2 is compared to the bs device
;specifications (if any) given in a17-a20 and a101.
;if the entry meets the specifications (in particular if
;the specifications are empty) the return is to link.
;if the entry does not meet the specifications the re-
;turn is to link + 2.
;
; at call at return
;w0 destroyed
;w1 unchanged
;w2 entry address unchanged
;w3 link destroyed
;
b. j4 w.
b24: rl. w0 a101. ; start:
sn w0 0 ; if no specifications
jl x3 ; then return;
ds. w2 j4. ;
rl w1 x2+14 ;
sl w1 0 ; if kind(entry) >= 0
jl. j3. ; then goto area entry;
bz w1 x2 ; not area entry:
bz w2 1 ; w1:=first slice(entry);
; w2:=first slice(scope);
sh w0 -1 ; if (device=main cat device
se w1 0 ; and first slice=0)
sn w1 x2 ; or first slice fits
am -2 ; then return to link
j1: al w3 x3+2 ; else return to link+2;
j2: dl. w2 j4. ;
jl x3 ; return;
j3: dl w1 x2+18 ; area entry:
sn. w0 (a17.) ; if name of device(entry)
se. w1 (a18.) ; =
jl. j1. ; name device(scope)
dl w1 x2+22 ; then return
sn. w0 (a19.) ; to link
se. w1 (a20.) ; else
jl. j1. ; return
jl. j2. ; to link+2;
0 ; saved w1
j4: 0 ; saved w2
e.
\f
;rc 25.05.73 fp utility, system 3, cat adm 2 ...18...
;texts:
a33: a51: <:<32><0>:>
a32: a61: <:<10><0>:>
a31: a52: <:.<0>:>
a34: a60: <:***<0>:>
a35: <: param <0>:>
a36: <: illegal scope<10><0>:>
a37: <: unknown<10><0>:>
a38: <: connect <0>:>
a39: <: bs device unknown<10><0>:>
a40: <: no entries found<10><0>:>
a41: <: call<10><0>:>
a42: <: no resources<10><0>:>
a43: <: bs device not ready<10><0>:>
a44: <: change bs device impossible<10><0>:>
a45: <: catalog error<10><0>:>
a46: <: entry in use<10><0>:>
a47: <: protected<10><0>:>
a48: <: error<10><0>:>
a53: <:=set<0>:>
a54=a60 ;<:***<0>:>
a63: <: ; <0>:>
a59: <:temp:>,0,0 ; start of scope table
a58: <:login:>,0,0
a57: <:user:>,0,0
a56: <:project:>,0
a55: <:system:>,0,0
<:own:>,0,0,0
a96=a59+2,a97=a59+4
a98=a59+6,a99=k-a59 ; end of table
a62: <:<10> ; <0>:>
;i-names are used for addressing by succesive am-es
i32=a32-a31,i33=a33-a32,i34=a34-a33,i35=a35-a34,i36=a36-a35
i37=a37-a36,i38=a38-a37,i39=a39-a38,i40=a40-a39,i41=a41-a40
i42=a42-a41,i43=a43-a42,i44=a44-a43,i45=a45-a44,i46=a46-a45
i47=a47-a46,i48=a48-a47
i52=a52-a51,i53=a53-a52,i54=a54-a53,i55=a55-a54,i56=a56-a55
i57=a57-a56,i58=a58-a57,i59=a59-a58,i60=a60-a59,i61=a61-a60
i62=a62-a61,i63=a63-a62
\f
;rc 03.04.74 fp utility, system 3, cat adm 2 ...19...
;mode kind table
a26:
<:ip:> ,0 , 1<23+ 0<12+ 0 ; internal process
<:bs:> ,0 , 1<23+ 0<12+ 4 ; backing storage area
a103=k-2 ; mode.kind bs
<:tw:> ,0 , 1<23+ 0<12+ 8 ; typewriter
<:tro:>,0 , 1<23+ 0<12+10 ; tape reader odd parity
<:tre:>,0 , 1<23+ 2<12+10 ; tape reader even parity
<:trn:>,0 , 1<23+ 4<12+10 ; tape reader no parity
<:trf:>,0 , 1<23+ 6<12+10 ; tape reader flexo code
<:tpo:>,0 , 1<23+ 0<12+12 ; tape punch odd parity
<:tpe:>,0 , 1<23+ 2<12+12 ; tape punch even parity
<:tpn:>,0 , 1<23+ 4<12+12 ; tape punch no parity
<:tpf:>,0 , 1<23+ 6<12+12 ; tape punch flexo code
<:tpt:>,0 , 1<23+ 8<12+12 ; tape punch teletype code
<:lp:> ,0 , 1<23+ 0<12+14 ; line printer
<:crb:>,0 , 1<23+ 0<12+16 ; card reader binary
<:crd:>,0 , 1<23+ 8<12+16 ; card reader decimal
<:crc:>,0 , 1<23+10<12+16 ; card reader ebcdic
<:mto:>,0 , 1<23+ 0<12+18 ; magnetic tape odd parity
<:mte:>,0 , 1<23+ 2<12+18 ; magnetic tape even parity
<:nrz:>,0 , 1<23 +4<12+18 ; magnetic tape 800 bpi odd
<:nrze:> , 1<23 +6<12+18 ; magnetic tape 800 bpi even
<:pl:> ,0 , 1<23+ 0<12+20 ; plotter
a27:
\f
;rc 08.02.72 fp utility, system 3, cat adm 2 ...20...
;the program lookup
s. c9 w.
g4: jl. w1 b0. ; start: initialize program;
jl. w3 b8. ; if left side then connect;
rs. w1 a16. ; save output zone address;
jl. w3 b17. ; prepare catalog scan;
c1: jl. w3 b11. ; next lookup: next param;
jl. b2. ; if end list then end program;
bl w3 x2+10 ; check param:
sn. w0 (a23.) ; if delim,kind <> space,name
sn w3 8 ; or next delim = point
jl. b13. ; then goto paramerror;
dl w1 x2+4 ; move name:
ds. w1 a18. ; move name
dl w3 x2+8 ; to name
ds. w3 a20. ; area;
aa w3 2 ; compute name key:
wa w3 4 ;
ba w3 6 ;
al w2 0 ;
wd. w3 a70. ;
rs. w2 c2. ; save name key;
jl. w3 b18. ; start scan: start cat scan
; at entry no <name key> ;
rl w3 x2+510 ; count:=no of entries with
; this name key;
sn w3 0 ; if count = 0
jl. c8. ; then goto done;
rs. w3 c3.
c4: rl w3 x2 ; check entry:
sn w3 -1 ; if unused place then
jl. c6. ; goto step entry;
bz w3 x2+1 ; compare name key:
ls w3 -3 ;
se. w3 (c2.) ; if name key does not fit
jl. c6. ; then goto step entry;
\f
;rc 1977.02.14 fp utility, system 3, cat adm 2 ...21...
; lookup, page 2
dl w1 x2+8 ; compare name:
sn. w0 (a17.) ; if first doubleword
se. w1 (a18.) ; does not fit
jl. c5. ; then goto count;
dl w1 x2+12 ;
sn. w0 (a19.) ; if second doubleword
se. w1 (a20.) ; does not fit
jl. c5. ; then goto count;
jl. w3 b23. ; find entry scope;
sh w1 10 ; if visible then
jl. w3 b15. ; output entry;
c5: rl. w1 c3. ; check count:
al w1 x1-1 ; count:=count-1
sn w1 0 ; if count = 0
jl. c8. ; then goto done;
rs. w1 c3. ;
c6: jl. w3 b21. ; next entry: step entry;
jl. c4. ; more in buf: goto check entry;
rs. w1 c3. ; (in order to force reading of
; the whole catalog)
jl. w3 b20. ; goto input cat seg;
jl. c4. ; more catalog: goto check;
c8: al w0 0 ; done: w0:=any output;
rx. w0 b16. ; next any output:=false;
se w0 0 ; if any output then
jl. c1. ; then goto next lookup;
jl. w3 b12. ; not found: outtext(***<name>
rl. w2 a2. ;
jl. w3 b4. ; <param>
jl. w3 b37. ; unknown );
jl. c1. ; goto next lookup;
c2: 0 ; name key
c3: 0 ; count
e. ; end of lookup
\f
;rc 78.04.11 fp utility, system 3, cat adm 2 ...22...
;the program search
b. c6 w.
g5: 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;
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 b15. ; ok: output entry;
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 search
b64:
; outdate
b. a5, b2 w.
rs. w3 b0. ; save return
jl. w3 b2. ; convclock
rs. w0 a2. ; save date
rs. w3 a3. ; save clock
rl. w1 a16. ; w1:=output zone
al. w0 a5. ;
am -2048 ;
jl. w3 h31.+12048 ; outtext(<: d.:>);
rl. w0 a2. ;
am -2048 ;
jl. w3 h32.+12048 ; outint(date);
0<23+48<12+6 ;
al w2 46 ;
am -2048 ;
jl. w3 h26.+12048 ; outchar(.);
rl. w0 a3. ;
am -2048 ;
jl. w3 h32.+12048 ; outint(clock);
0<23+48<12+4 ;
jl. (b0.) ; return;
a2: 0 ; saved clock
a3: 0 ; saved date
a5: <: d.<0>:> ; textconstant
b0: 0 ; saved return
b2:
e.
\f
;rc 78.04.11 fp utility, system 3, cat adm 2 ...22a...
; procedure convert clock (short clock)
;
;
; this procedure is an inversion of the following algorithm
; for computing day-number from a date (year,month,date)
; extended with a conversion of the time of the day:
;
;
; if month<3 then
; begin
; month:=month+12;
; year:=year-1;
; end;
; dayno:=(1461*year)//4 + (153*month+3)//5 + day;
;
;
;
; call: return:
;
; w0 short clock year*10000+month*100+date
; w1 irrelevant destroyed
; w2 irrelevant destroyed
; w3 return hour*100+minute
;
;
;
b. a13, b0 w.
ld w2 -100 ; clear w1,w2
rs. w3 a8. ; save return address
al w3 0 ; clear w3
ld w0 10 ; w3,w0:=short clock<10 (=truncated clock>9)
wd. w0 a2. ; w0:=dayno
al w3 x3+a13 ; add minute rounding
wd. w3 a1. ; w3:=hour
wd. w2 a0. ; w2:=minute
ds. w3 a10. ; save minute,hour
al w3 0 ; clear w3
ld w2 -100 ; clear w1,w2
ls w0 2 ; w0:=dayno*4
wa. w0 a5. ; add offset
wd. w0 a4. ; w0:=year
ls w3 -2 ; w3 is converted
wm. w3 a6. ; to fifthdays
al w3 x3+a11 ; w3:=w3+three months offset
wd. w3 a3. ; w3:=month
sh w3 12 ; if month>12 then
jl. b0. ; begin
ba. w0 1 ; increase year
al w3 x3-12 ; decrease month
b0: al w2 x2+a12 ; end
wd. w2 a6. ; w2:=date
rs w3 2 ; save month (in w1)
wm. w0 a7. ; w0:=year*100
wa w0 2 ; + month
wm. w0 a7. ; * 100
wa w0 4 ; + date
rl. w3 a10. ; w3:=hour
wm. w3 a7. ; * 100
wa. w3 a9. ; + minute
jl. (a8.) ; return
\f
;rc 78.04.11 fp utility, system 3, cat adm 2 ...22b...
a0: 1172 ; units per minute
a1: 70313 ; units per hour
a2: 1687500 ; units per day
a3: 153 ; days in the five months (march-july)
a4: 1461 ; days in four years
a5: 99111 ; offset for computing year
a6: 5 ;
a7: 100 ; constant for packing date and time
a8: 0 ; saved return address
a9: 0 ; saved minute
a10: 0 ; saved hour
a11=461 ; three months offset
a12=5 ; one days offset
a13=586 ; half a minute
e.
\f
;rc 78.04.11 fp utility, system 3, cat adm 2 ...22c...
b65:
; 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.
a100=k ; start buf for cat scan
\f
;rc 28.02.72 fp utility, system 3, cat adm 2 ...23...
;the core area of the code for lookup and search is
;used as data area for the other programs:
a110=g4 ; name area 2
a111=g4+2
a112=g4+4 ;
a113=g4+6
a114=g4+8 ; for name table address
a119=g4+10 ; start of head of entry
a120=g4+14
a115=g4+16 ; name area 3
a116=g4+18
a117=g4+20
a118=g4+22
a127=g4+24 ; tail: kind
a128=g4+26 ; doc.name
a129=g4+28 ; first doubleword
a130=g4+32 ; second doubleword
a131=g4+34 ; name table address
a132=g4+36 ; file
a133=g4+38 ; block
a134=g4+40 ; contry
a135=g4+42 ; length
a140=g4+44 ; name area 4
a141=g4+46
a142=g4+48
a143=g4+50
a144=g4+52 ; name table address
;area for entry lookup
;used by end program
a80=g4+56 ; first slice,keys
a81=g4+57 ; keys
a82=g4+58 ; interval low
a83=g4+60 ; interval up
a84=g4+62 ; name start
a85=g4+64 ; first doubleword
a86=g4+68 ; second doubleword
a87=g4+70 ; kind
a88=g4+72 ; doc.name start
a89=g4+74 ; first doubleword
a90=g4+78 ; second doubleword
a91=g4+80 ; name table address
a92=g4+82 ; file
a93=g4+84 ; block
a94=g4+86 ; contry
a95=g4+88 ; length
\f
;rc 28.02.72 fp utility, system 3, cat adm 2 ...24...
;procedure read scope parameter
;
;reads the scope specifications (if any) and initializes the vari-
;ables a12-a14,a17-a20,a101-a102 as described below.
;in case of missing or illegal scope end program is entered after
;output of an error message.
;
;value of variables:
;
; temp login user project system own
;a12-a13 stand stand user max max undefined
;a14 0 2 4 6 8 10
;
; no bs device not main cat dev main cat device
;a17-a20 0 device name device name
;a101 0 1<11+table rel 1<23+1<11+table rel
;
;a102: address of scope parameter in command stack
;
; at call at return
;w0 destroyed
;w1 destroyed
;w2 destroyed
;w3 link scope value (as a14)
;
b. j12 w.
b22: rs. w3 j0. ; start: save link;
jl. w3 b11. ; next param;
jl. b2. ; if end list then end program;
rs. w2 a102. ; save param address;
se. w0 (a23.) ; if del,kind <> space,name
jl. b14. ; then goto scope error;
al w3 0 ; search in table:
dl w1 x2+4 ; index := 0;
j1: sn. w0 (x3+a59.) ; compare scope name:
se. w1 (x3+a96.) ; if param <> table(index)
jl. j2. ; then
dl w1 x2+8 ; goto
sn. w0 (x3+a97.) ; next index;
se. w1 (x3+a98.) ;
jl. j3. ;
ls w3 -2 ; scope found: save value;
rs. w3 a14. ; interval in scope:=
jl. x3+j4. ; case scope of
j4: am 0 ; ( standard
am -4 ; standard
am -4 ; user
am 0 ; max
dl. w1 a11. ; max
ds. w1 a13. ; undefined );
se w3 6 ; test project allowed:
jl. j5. ; if scope = project then
sn. w0 (a8.) ; begin
se. w1 (a9.) ; if max = user
jl. j5. ; then goto scope error
jl. b14. ; end;
j5: rl w0 x2+10 ; look for bs dev. spec:
sl. w0 (a29.) ; if next del <> point
sh. w0 (a25.) ; or next del = end list
jl. (j0.) ; then return;
se. w0 (a24.) ; if next del,kind <> point,name
jl. b14. ; then goto scope error;
\f
;rc 10.02.72 fp utility, system 3, cat adm 2 ...25...
;procedure read scope parameter continued:
jl. w3 b11. ; next param;
ps -2 ; end list: testoutput;
rl w0 x2+10 ; bs device specified:
sl. w0 (a29.) ; if next del = point
jl. b14. ; then goto scope error;
dl w1 x2+8 ;
ds. w1 a20. ; move device name
dl w1 x2+4 ; to name area
ds. w1 a18. ;
al w2 0 ; search device: index:=0;
j6: am (92) ; next device:
rl w3 x2 ; w3 := name.table(index);
sn w3 0 ; if end table
jl. j12. ; then goto not found;
sn w0 (x3-18) ; if first half
se w1 (x3-16) ; name(param) <> name(index)
jl. j7. ; then goto step device;
dl. w1 a20. ;
sn w0 (x3-14) ; if second half
se w1 (x3-12) ; name(param) <> name(index)
jl. j8. ; then goto step device;
dl. w1 a74.+2 ; found:
sn w0 (x3-28) ; reference :=
se w1 (x3-26) ; if catalog(device)
jl. j9. ; = main catalog
dl. w1 a74.+6 ; then 1<23 + 1<11 + w2
sn w0 (x3-24) ; else
se w1 (x3-22) ; 1<11+w2;
jl. j9. ;
lo. w2 j10. ;
j9: lo. w2 j11. ;
rs. w2 a101. ;
rl. w3 a14. ;
jl. (j0.) ; return;
j8: dl. w1 a18. ; step device:
j7: al w2 x2+2 ; index:=index+2;
jl. j6. ; goto next device;
j10: 1<23 ;
j11: 1<11 ;
\f
;rc 15.02.72 fp utility, system 3, cat adm 2 ...26...
;procedure read scope parameter continued
j3: dl w1 x2+4 ; next index:
j2: al w3 x3+8 ; index:=index+8;
se w3 a99 ; if index <> length of table
jl. j1. ; then goto compare
jl. b14. ; else goto scope error;
j0: 0 ; saved link
j12: jl. w3 b26. ; bs device not found:
jl. w3 b39. ; outtext(***<prog.name> bs device unknown
jl. b2. ; goto end program;
e. ;end procedure read scope parameter
;call error:
; ***<prog.name> call
;
;followed by end program
;
b25: jl. w3 b12. ; outtext(***<prog.name> call);
jl. w3 b41. ;
jl. b2. ; goto end program;
;resource trouble
; ***<prog.name> no resources
;
;followed by end program
;
b28: jl. w3 b12. ; outtext(***<prog.name>
jl. w3 b42. ; no resources);
jl. b2. ; goto end program;
\f
;rc 78.04.10 fp utility, system 3, cat adm 2 ...27...
;the program clear:
;
b. c4 w.
g6: jl. w1 b0. ; start: init program;
jl. b25. ; left side: call error;
jl. w3 b22. ; read scope parameter;
sl w3 8 ; if scope value >= 8
jl. b14. ; then goto scope error;
c0: dl. w1 a13. ; set cat base:
al. w3 a15. ; cat.base := interval(scope);
jd 1<11+72 ;
c1: jl. w3 b11. ; next clear: next param;
jl. b2. ; end list: goto end program;
bz w1 x2+10 ;
sn. w0 (a23.) ; if del,kind <> space,name
sn w1 8 ; or next delim = point
jl. b13. ; then goto paramerror;
dl w1 x2+4 ; move name to area:
ds. w1 a85. ;
dl w1 x2+8 ;
ds. w1 a86. ;
al. w3 a84. ; create entry process:
al. w1 a80. ; lookup entry(name);
jd 1<11+76 ;
se w0 0 ; if not found
jl. c2. ; then goto unknown;
al w2 x1 ; test scope:
jl. w3 b23. ; find scope;
se. w1 (a14.) ; if scope(entry) <> scope in call
jl. c2. ; then goto unknown;
jl. w3 b24. ; test bs device spec;
jl. c3. ; ok: goto remove;
; not ok:
c2: jl. w3 b26. ; unknown: outtext(***<prog.name>
rl. w2 a2. ; <scope>
jl. w3 b4. ; <param>
jl. w3 b37. ; unknown );
jl. c0. ; goto set catbase);
c3: al. w3 a84. ; remove:
jd 1<11+48 ; remove entry;
se w0 2 ; if catalog error,
jl. c4. ; doc unmounted or not ready
jl. w3 b26. ; then outtext(<:***<prog><scope><10>:>);
jl. w3 b43. ; bs device not ready<10>:>);
jl. c1. ; goto next clear;
c4: se w0 5 ;
jl. c1. ; goto next clear;
jl. w3 b26. ; entry in use:
rl. w2 a2. ; outtext(<:***<prog name> <scope>
jl. w3 b4. ; <param>
jl. w3 b46. ; entry in use<10>:>);
jl. c0. ; goto set catbase;
e.
\f
;rc 21.08.73 fp utility, system 3, cat adm 2 ...28...
;the program scope:
b. c40 w.
;error text output:
c20: am -4 ; error cause 4 (protected)
c7: am 1 ; error cause 8 (change bs device)
c11: am 1 ; error cause 7 (catalog error)
c0: al w0 6 ; error cause 6 (no resources)
c1: rs. w0 c2. ; start: save cause;
jl. w3 b3. ; reestablish cat base;
jl. w3 b26. ; error text:
rl. w2 a2. ; ***<prog.name> <scope>
jl. w3 b4. ; <param>
am. (c2.) ;
bl. w1 c3. ; outtext(text(cause));
jl. w3 x1+b30. ;
jl. c5. ; goto next scope;
c2: 0 ; saved cause;
;text table:
;causes: 0,1,2,3,4,5,6,7,8
;texts:
;error,error,bs device not ready,unknown,
;protected,entry in use, no resources,catalog error
;change bs device impossible
h.
c3:b48-b30,b48-b30,b43-b30,b37-b30,
b47-b30,b46-b30,b42-b30,b45-b30
b44-b30
w.
;procedure find old entry:
;sets the catalog base to the scope interval and
;makes a catalog lookup of the entry name (a110)
;into the lookup area a80.
;if no entry is found the return is to link. if
;an entry is found the return is to link+2. at
;return the name address is still in w3 and the
;catalog base is still the scope interval.
; call return
;w0 undefined
;w1 undefined
;w2 undefined
;w3 link name address
;
b. j5 w.
j0: 0 ; saved link
c23: rs. w3 j0. ; start: save link;
dl. w1 a13. ; set catbase
al. w3 a15. ; to scope interval;
jd 1<11+72 ;
al. w3 a110. ;
al. w1 a80. ; lookup entry(name);
jd 1<11+76 ;
sn w0 0 ; if found then
jl. j1. ; then goto test interval;
sn w0 3 ; if entry unknown
jl. (j0.) ; then return to link;
jl. c11. ; else goto catalog error;
\f
;rc 25.05.73 fp utility, system 3, cat adm 2 ...29...
;scope page 2:
j1: rl. w2 j0. ; test interval:
dl. w1 a83. ;
sn. w0 (a12.) ; if interval(entry)
se. w1 (a13.) ; < >
jl x2 ; interval(scope) then goto link;
jl x2+2 ; return to link+2;
e.
;start of program itself:
g10: am -2048 ; start:
jl. w1 b0.+2048 ; init program;
jl. b25. ; left side: call error;
jl. w3 b22. ; get scope: read scope param;
sl w3 8 ; if scope >= 8
jl. b14. ; then goto scope error;
sl w3 4 ;
al w3 3 ; save key(scope);
rs. w3 c19. ;
al. w3 a140. ; get work name:
jd 1<11+68 ;
c5: jl. w3 b11. ; next scope: next param;
jl. c4. ; end list: end program;
bz w1 x2+10 ; check param:
sn. w0 (a23.) ; if del,kind <> sp,name
sn w1 8 ; or next delim = point
jl. b13. ; then paramerror;
dl w1 x2+4 ; move name
ds. w1 a111. ; to
dl w1 x2+8 ; name area no 2
ds. w1 a113. ;
al w0 0 ; work in use :=
rs. w0 c18. ; false;
al. w3 a110. ; lookup entry (name);
al. w1 a119. ;
jd 1<11+76 ;
sn w0 0 ; if found then
jl. c9. ; goto check interval;
sn w0 3 ; if not found then
jl. c1. ; then goto error;
jl. c11. ; goto error cause 1;
c4: am -2048
jl. b2.+2048
c18: 0 ; work in use (boolean)
c19: 0 ; key(scope)
c17: 0 ; non area entry
\f
;rc 15.10.74 fp utility, system 3, cat adm 2 ...30...
;scope page 3:
c9: dl. w1 a120. ; check interval:
al w1 x1-1 ;
sl. w0 (a10.) ; if int.low < max.low
sl. w1 (a11.) ; or int.upp > max upp
jl. c20. ; then goto protected;
al w0 0 ; non-area := false;
rs. w0 c17. ;
rl. w0 a101. ; compare devices:
sn w0 0 ; if no device in scope
jl. c22. ; then goto maybe set key 3;
rl. w1 a127. ; if nos of segments >= 0
sl w1 0 ; then goto compare names;
jl. c8. ; non-area entry:
sh w0 0 ; if main cat device in scope
jl. c22. ; then goto maybe set key 3;
bz. w1 a119. ; check entry scope:
sn w1 0 ; if entry already in aux cat
jl. c6. ; and
se w0 x1 ; aux.cat(entry) <> aux.cat(scope)
jl. c7. ; then goto change device error;
c6: rs. w0 c17. ; non-area := true;
jl. c22. ; goto maybe set key 3;
;
c8: dl. w1 a129. ; compare names:
sn. w0 (a17.) ; if device name (proc)
se. w1 (a18.) ; <>
jl. c7. ; device name (scope)
dl. w1 a130. ; then
sn. w0 (a19.) ; goto
se. w1 (a20.) ; change device error;
jl. c7. ;
\f
;rc 78.04.10 fp utility, system 3, cat adm 2 ...31...
;scope page 4:
c22: rl. w1 c19. ; maybe set key 3:
sh w1 2 ; if key(scope) <= 2
jl. c10. ; then goto set interval;
am. (c17.) ; if not non-area
sn w1 x1 ; then goto permanent;
jl. c24. ;
al. w2 a17. ; aux cat:
jd 1<11+90 ; permanent into aux cat;
jl. c25. ; goto test result;
c24: jd 1<11+50 ; permanent entry;
c25: sn w0 0 ; if ok
jl. c10. ; then goto set interval;
; permanent fault:
am. (c18.) ; if work in use
se w1 x1 ; then
jl. c28. ; goto repair and give up;
sn w0 6 ; if claims exceeded then
jl. c21. ; then goto try rename;
jl. c1. ; goto error;
c10: dl. w1 a13. ; set interval:
jd 1<11+74 ; change entry interval(entry name);
sn w0 0 ; if ok then
jl. c14. ; goto almost ok finis;
; old entry present:
jl. w3 c23. ; find old entry;
jl. c11. ; not found: goto error 1 (catalog error);
jd 1<11+48 ; found: remove entry;
se w0 5 ; if reserved (by boss) then
jl. 18 ; begin
jl. w3 b3. ; reestablish catbase;
rl. w1 a119. ;
ls w1 21 ;
ls w1 -21 ; permanent with
al. w3 a110. ; oldkey
jd 1<11+50 ; errortype:=in use;
al w0 5 ;
jl. c1. ; end
se w0 0 ; if remove not possible
jl. c11. ; then goto catalog error;
jl. w3 b3. ; reestablish cat base;
al. w3 a110. ;
jl. c10. ; goto set interval;
c14: rl. w1 c19. ; almost ok finis:
sn w1 3 ; if key(scope) = 3
jl. c15. ; then goto remove work;
dl. w1 a13. ;
al. w3 a15. ; set catbase to
jd 1<11+72 ; scope interval
rl. w1 c19. ; restore key;
al. w3 a110. ; restore name addr;
am. (c17.) ; if not non-area
sn w1 x1 ; then goto permanent;
jl. c26. ;
al. w2 a17. ; aux catalog:
jd 1<11+90 ; permanent into aux cat;
jl. c27. ; goto test result;
c26: jd 1<11+50 ; permanent entry(key);
c27: se w0 0 ; if not ok
jl. c1. ; then goto error;
am -2048 ;
jl. w3 b3.+2048 ; reestablish catbase;
jl. c5. ; goto next scope;
c15: rl. w0 c18. ; remove work:
sn w0 0 ; if not work in use
jl. c5. ; then goto next scope;
al. w3 a140. ;
jd 1<11+48 ;
jl. c5. ; goto next scope; remove(work);
\f
;rc 79.08.30 fp utility, system 3, cat adm 2 ...32...
;scope page 5:
c21: jl. w3 c23. ; try rename: find old entry;
jl. c0. ; not found: no resources;
rl. w1 a81. ; found, check entry key:
ls w1 21 ; load keys;
ls w1 -21 ; shift out namekey;
se. w1 c19. ; if entrykey<>scopekey then
jl. c0. ; goto no resources;
al. w1 a140. ; found and rigth key:
jd 1<11+46 ; rename entry;
se w0 0 ; if not ok
jl. c1. ; then goto error;
al. w3 a140. ;
dl. w1 a7. ;
jd 1<11+74 ; change entry interval to standard;
dl. w1 a7. ;
al. w3 a15. ; set cat base to standard;
jd 1<11+72 ;
al w1 0 ;
al. w3 a140. ;
jd 1<11+50 ; permanent entry(key 0);
rs. w3 c18. ; work in use := true;
am -2048
jl. w3 b3.+2048 ; reestablish cat base;
al. w3 a110. ;
jl. c22. ; goto set key again;
c28: dl. w1 a7. ; repair and give up:
al. w3 a15. ; set cat base to standard;
jd 1<11+72 ;
rl. w1 c19. ;
al. w3 a140. ;
bl. w2 a80. ; if old entry was
sh w2 -1 ; permanent into an aux cat
jl. c29. ; then goto perm work aux;
jd 1<11+50 ; permanent work entry(key(scope));
c30: dl. w1 a13. ;
jd 1<11+74 ; change entry interval
al. w1 a110. ; (work,scope interval);;
jd 1<11+46 ; rename entry ( work name to name);
jl. c0. ; goto error(no resources);
c29: am (92) ; perm work aux:
am (x2-1<11) ;
al w2 -18 ; get aux cat address;
dl w1 x2+2 ; move aux dev name
ds. w1 c31. ; to name area;
dl w1 x2+6 ;
ds. w1 c32. ;
al. w2 c33. ;
rl. w1 c19. ; permanent into
jd 1<11+90 ; saved aux cat;
jl. c30. ; goto change interval;
c33: 0 ; device name
c31: 0,0 ;
c32: 0 ;
e.
g2=k-g3
a0=g2
\f
;rc 07.04.72 fp utility, system 3, cat adm 2 tails
i.e. ; end program segment
m.rc 1977.08.29 fp utility, sys 3, cat adm 2
m. lookup,search,clear,scope
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
0,r.4
s2 ; month year
0,r.2
2<12+g6-g3 ; entry clear
g2
g1: 1<23+4
0,r.4
s2 ; month year
0,r.2
2<12+g10-g3 ; entry scope
g2
d.
p.<:insertproc:>
l.
▶EOF◀