|
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: 51456 (0xc900)
Types: TextFile
Names: »set3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »set3tx «
\f
; rc 07.04.72 fp utility, system 3, cat adm 1
; the catalog administration 1 consists of the programs:
; set, entry, rename, nextfile.
; the text is assembled with a call of the slang assembler
; of the following kind:
;
; (set=slang text
; set setmt clearmt entry changeentry assign rename permanent cfversion nextfile)
;rc 22.05.72 fp utility, system 3, cat adm 1 ...01...
b. g15 w. ; outer block for insertproc
d.
p.<:fpnames:>
l.
s. a200, b200, i100 w.
k=h55+10000
w.
g3=k
;procedure init program
;
;entered just after entry of program. the various pointers are
;set. at return w1 contains curr out zone address.
;the return is to link if a left side is in the program call -
;else to link+2.
;
;observe that w1 is used as link.
;
b0: ds. w3 a2. ; save first core, pointer;
al w3 x3+2 ;
rs. w3 a3. ; save address of program name;
bz w2 x3-2 ;
se w2 6 ; return:=
am 2 ; if delim <> 6 then link+2
al w3 x1 ; else link;
al. w1 h21.+10000 ; w1:=addr of curr out zone;
jl x3 ; goto return;
\f
;rc 22.05.72 fp utility, system 3, cat adm 1 ...02...
;end program:
b2: am. (a22.) ; set ok:
se w1 x1 ; w2:=
am 1 ; if not ok then 1
al w2 0 ; else 0;
jl. h7.+10000 ; goto fp end program;
;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 22.05.72 fp utility, system 3, cat adm 1 ...03...
;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
; fgs 1982.12.17 fp utility, system 3, cat adm 1 ...04...
;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:
b50: am i50 ; <: no room<10>:>
b49: am i49 ; <: catalog error<10>:>>
b48: am i48 ; <: error<10>:>
b47: am i47 ; <: protected<10>:>
b46: am i46 ; <: entry in use<10>:>
b45: am i45 ; <: name conflict<10>:>
b44: am i44 ; <: change bs device impossible<10>:>
b43: am i43 ; <: change kind impossible<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 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 28.05.72 fp utility, system 3, cat adm 1 ...05...
; rc 23.4.71 fp utility nextfile page 1
b. a10,b10,c10
w.
g11: ; entry nextfile
k=k-10000 ; adjust k-value
rs. w3 b1. ; save w3
bl w0 x3 ; w0:= separator;
se w0 6 ; if separator= equal then
jl. a0. ; begin
al w2 1 ; error:= true;
rs. w2 b2. ;
al. w0 c1. ; outtext(<:
jl. w3 h31.-2 ; ***nextfile call:>);
jl. a7. ; goto end nextfile;
; end;
a0: rl. w3 b1. ; search for param: reestablish w3
ba w3 x3+ 1 ; w3:= addr of next item;
rs. w3 b1. ; save w3
bl w0 x3 ; w0:= separator;
sh w0 2 ; if w0<=2 then
jl. a7. ; goto end nextfile;
se w0 4 ; if separator= space
jl. a1. ; and
bl w0 x3+10 ; next separator<>point
sn w0 8 ; and
jl. a1. ;
bl w0 x3+ 1 ; kind(parameter)
se w0 10 ; =text
jl. a1. ; then goto
jl. a3. ; lookup entry;
a1: al w2 1 ; comment parameter error;
rs. w2 b2. ; error:= true;
al. w0 c2. ; outtext(<:
jl. w3 h31.-2 ; ***nextfile param :>);
rl. w3 b1. ; reestablish w3
a2: bl w2 x3 ; nextsearch: w2:=separator
al. w0 x2+c7. ; outtext(separator)
jl. w3 h31.-2 ;
rl. w3 b1. ; reestablish w3
bl w2 x3+ 1 ; w2:=kind(parameter)
se w2 10 ; if kind(parameter)
jl. a8. ; =text then
al w0 x3+ 2 ; outtext(parameter)
jl. w3 h31.-2 ;
jl. a9. ; else
a8: rl w0 x3+ 2 ;
jl. w3 h32.-2 ; outinteger(parameter)
1 ; layout
\f
;rc 28.02.72 fp utility, system 3, cat adm 1 ...06...
; rc 28.2.72 nextfile page 2
a9: al. w0 c5. ;
jl. w3 h31.-2 ; ourcr
rl. w3 b1. ; reestablish w3
ba w3 x3+ 1 ; w3:= addr of next item;
rs. w3 b1. ; save w3
bl w0 x3 ; w0:= separator;
sh w0 2 ; if w0<=2 then
jl. a7. ; goto end nextfile;
se w0 4 ; if separator<>space
jl. a2. ; or
bl w0 x3+10 ; next separator=point
sn w0 8 ; or
jl. a2. ;
bl w0 x3+ 1 ; kind(parameter)
se w0 10 ; <>text then
jl. a2. ; goto nextsearch;
; lookup entry:
a3: al. w1 b3. ; w1:= tail addr;
al w3 x3+ 2 ; w3:= name addr;
jd 1<11+42 ; w0:= lookup entry
sn w0 0 ; if w0=0 then goto entry found;
jl. a6. ;
;
; not note not entry:
al w0 1 ; error:= true;
rs. w0 b2. ;
al. w0 c0. ; outtext(<:
jl. w3 h31.-2 ; ***nextfile :>);
rl. w3 b1. ; reestablish w3;
al w0 x3+ 2 ; outtext(
jl. w3 h31.-2 ; parameter);
al. w0 c3. ; outtext(<:
jl. w3 h31.-2 ; unknown:>);
rl. w3 b1. ; reestablish w3
jl. a0. ; goto search for param;
;
; entry found: (w3=name addr)
a6: rl. w1 b4. ; b4=addr of file number in entry tail
al w1 x1+ 1 ; file(entry tail):=
rs. w1 b4. ; file(entry tail)+1;
al. w1 b3. ; w1:= tail addr;
jd 1<11+44 ; w0:= change entry;
sn w0 0 ; if w0= 0 then
jl. a0. ; goto search for param;
;
;
al w0 1 ; error:= true;
rs. w0 b2. ;
al. w0 c0. ; outtext(<:
jl. w3 h31.-2 ; ***nextfile:>);
rl. w3 b1. ; reestablish w3;
al w0 x3+ 2 ; w0:= name addr;
jl. w3 h31.-2 ; outtext(parameter);
al. w0 c4. ;
jl. w3 h31.-2 ; outtext(<: protected:>);
rl. w3 b1. ; reestablish w3
jl. a0. ; goto search for param;
\f
;rc 28.05.72 fp utility, system 3, cat adm 1 ...07...
; rc 23.4.71 fp utility nextfile page 3
a7: rl. w2 b2. ; end nextfile: w2:= error
jl. h7. ; goto fp-endprogram;
;
;
b1: 0 ; saved w3
b2: 0 ; error
b3: 0,0,r.9 ; tail addres
b4=b3+12
;
c0: <:***nextfile <0>:>
c1: <:***nextfile call<10><0>:>
c2: <:***nextfile param <0>:>
c3: <: unknown<10><0>:>
c4: <: protected<10><0>:>
c5: <:<10>:>
c6: <: :>, <:=:>, <:.:>
c7=c6-4
k=k+10000 ; adjust k-value
e. ; end block
\f
;rc 76.05.31 fp utility, system 3, cat adm 1 ...08...
;working locations:
a1: 0 ; last available core
a2: 0 ; param pointer in fp stack
a3: 0 ; prog. name address
a16: 0 ; output zone address
a22: 0 ; ok status
a23: 4<12+10 ; space,name
a24: 8<12+10 ; point,name
a25: 4<12-1 ; test end list
a29: 8<12+ 4 ; point,integer
a30: <:d:>
\f
; fgs 1982.12.17 fp utility, system 3, cat adm 1 ...09...
;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: <: change kind impossible<10><0>:>
a44: <: change bs device impossible<10><0>:>
a45: <: name conflict<10><0>:>
a46: <: entry in use<10><0>:>
a47: <: protected<10><0>:>
a48: <: error<10><0>:>
a49: <: catalog error<10><0>:>
a50: <: no room<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,i49=a49-a48,i50=a50-a49
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
;fgs 1984.06.18 fp utility, system 3, cat adm 1 ...10...
;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
<:trz:>,0 , 1<23+ 8<12+10 ; tape reader zeroes allowed
<: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
<:mtlh:> , 1<23+ 0<12+18 ; magnetic tape, low speed, high density, odd parity
<:mtll:> , 1<23+ 4<12+18 ; magnetic tape, low speed, low density, odd parity
<:mthh:> , 1<23+128<12+18 ; magnetic tape, high speed, high density, odd parity
<:mthl:> , 1<23+132<12+18 ; magnetic tape, high speed, low density, odd parity
<:pl:> ,0 , 1<23+ 0<12+20 ; plotter
a27: 0
\f
;rc 28.02.72 fp utility,system 3, cat adm 1 ...11...
;area for a single entry lookup:
a80: 0 ; first slice , keys
a81=k-1 ; keys
a82: 0 ; interval low
a83: 0 ; interval up
a84: 0 ; name
a85: 0 ; first doubleword
0 ;
a86: 0 ; second doubleword
a87: 0 ; kind
a88: 0 ; doc.name
a89: 0 ; first doubleword
a136: 0 ;
a90: 0 ; second doubleword
a91: 0 ; name table address
a92: 0 ; file
a93: 0 ; block
a94: 0 ; contry
a95: 0 ; length
;call error
; ***<prog.name> call
;
;followed by exit to end program
;
b25: jl. w3 b12. ; outtext(***<prog.name>);
jl. w3 b41. ; outtext(call);
jl. b2. ; goto end program
\f
;rc 22.05.72 fp utility, system 3, cat adm 1 ...12...
;procedure next compound parameter
;
;used by set and entry programs
;
;reads the next compound parameter from the stack. only
;parameters of the forms:
;<name> , <integer> or <integer1>.<integer2> are accepted.
;other parameters causes an error message and exit to end
;program. a parameter of the type <int>.<int> is interpre-
;ted as <integer1> shift 12 + <integer2>.
;
;if end list is found ( no parameters ) the return is to link
;otherwise to link + 2.
;
; call return
;w0 4<12+10 not 4<12+10
;w1 first 3 chars integer
;w2 addr of item destroyed
;w3 link destroyed destroyed
;
b. j2 w.
j0: 0 ; saved link+2
j1: 0 ; saved link
b27: al w2 x3+2 ; start: save link,link+2;
ds. w3 j1. ;
jl. w3 b11. ; next param;
jl. (j1.) ; end list: return to link;
bz w3 1 ; w3:=length(param);
am x3 ;
rl w3 x2 ; w3:=next delim,kind;
rl w1 x2+2 ; w1:=param (first part may be);
sh. w3 (a23.) ; if next del <> point
jl. (j0.) ; then return to link+2;
se. w0 (a23.) ; compound param: if del,kind<>point,int
se. w3 (a29.) ; or next del,kind<>point integer
jl. b13. ; then goto paramerror;
jl. w3 b11. ; next param;
ks -3 ; end list:testoutput;
ls w1 12 ; w1:=first integer shift 12
wa w1 x2+2 ; + second integer;
jl. (j0.) ; return to link+2;
e.
\f
;rc 78.03.18 fp utility, system 3, cat adm 1 ...13...
;the program set
;
b. c9 w.
g7: jl. w1 b0. ; start: init program;
jl. c1. ; if no left side
jl. b25. ; then goto call error;
c1: rl. w3 a1. ; move name:
dl w1 x3+4 ; move name
ds. w1 a111. ; to
dl w1 x3+8 ; name
ds. w1 a113. ; area;
jl. w3 b27. ; get kind: next compound param;
jl. b80. ; end list: goto set entry;
se. w0 (a23.) ; if not name param
jl. c2. ; then goto store kind;
dl w1 x2+4 ; search in table:
al. w2 a26. ; index:=first(table);
c3: sn w0 (x2) ; compare: if param
se w1 (x2+2) ; <> table(index)
jl. c4. ; then goto step index;
rl w1 x2+4 ; found: kind:=kind(index);
c2: rs. w1 a87. ; store kind:
jl. w3 b27. ; doc.name: next comp. param;
jl. c9. ; end list: goto set shortclock;
se. w0 (a23.) ; if not name param
jl. c5. ; then goto integer doc.name;
dl w1 x2+4 ; move doc.name:
ds. w1 a89. ;
dl w1 x2+8 ;
ds. w1 a90. ;
c8: al. w3 a91. ; rest of tail:
rs. w3 c7. ; pointer:=name table addr;
rl. w2 a2. ;
ba w2 x2+1 ;
rl w0 x2 ; if nextparam=name
sn. w0 (a23.) ; then
jl. c0. ; goto test if date
sh. w0 (a25.) ; if nextsep=endsep then
jl. c9. ; goto set shortclodk;
c6: jl. w3 b27. ; next tail: next comp. param;
jl. b80. ; end list: goto set entry;
sn. w0 (a23.) ; if name param
jl. b13. ; the paramerror;
rl. w3 c7. ;
sl. w3 a95.+2 ; if too many parameters
jl. b13. ; then goto param error;
rs w1 x3 ; store parameter;
al w3 x3+2 ; step pointer;
rs. w3 c7. ;
jl. c6. ; goto next tail;
c5: sl w1 0 ; integer doc.name:
sl w1 2 ; if doc.name < 0 or >= 2
jl. b13. ; then goto paramerror;
rs. w1 a88. ; store parameter;
jl. c8. ; goto rest of tail;
c9: dl w1 110 ; set shortclock:
ld w1 5 ;
rs. w0 a91. ; save shortclock
jl. b80. ; goto set entry;
\f
; fgs 1982.12.17 fp utility, system 3, cat adm 1 ...14...
;set page 2
c4: al w2 x2+6 ; step index: index:=index+6;
se. w2 a27. ; if not end table
jl. c3. ; the goto compare
jl. b13. ; else paramerror;
c7: 0 ; pointer
c0:
; test if date, program set
rl w0 x2+2 ;
se. w0 (a30.) ; if name<>d
jl. c6. ; then return;
rl w0 x2+10 ; if nextsep<>pointinteger
se. w0 (a29.) ; then return;
jl. c6. ;
rl w1 x2+16 ; clock;
rl w0 x2+14 ; if nextnextsep<>pointinteger
se. w0 (a29.) ; then
al w1 0 ; clock:=0;
rl w0 x2+12 ; date;
jl. w3 b79. ; transform date and clock;
jl. b13. ; if dateerror then paramerror;
rl. w3 c7. ;
rs w0 x3 ; save shortclock;
al w3 x3+2 ; pointer:=pointer+2;
rs. w3 c7. ;
jl. w3 b11. ;
am
jl. w3 b11. ;
am
rl w0 x2+4 ; if nextsep=pointinteger
sn. w0 (a29.) ; then
jl. w3 b11. ; nextparam;
am
jl. c6. ; goto next tail;
e.
; set entry
;
;creates a new catalog entry or changes the tail of an existing one
;according to name in a110-a113 and tail in a87-a95.
;
b. j9 w.
b80: al. w1 a87. ;
al. w3 a110. ;
rl. w0 a27. ; if program
sl w0 2 ; =changeentry
jl. j2. ; then goto change entry;
jd 1<11+40 ; create entry;
sn w0 0 ; if ok
jl. b2. ; then end program;
sn w0 3 ; if entry exists
jl. j2. ; then goto change entry;
j1: rs. w0 j0. ; error: save cause;
j6: jl. w3 b12. ; error message ***<prog.name>
jl. w3 b33. ; <sp>
al. w0 a110. ;
jl. w3 b30. ; <name>
am. (j0.) ;
bl. w1 j8. ; w1:=addr.table(cause);
jl. w3 x1+b30. ; outtext(text(cause));
jl. b2. ; goto end program;
j0: 0 ; cause
; text address table
; for causes -1,0,1,2,3,4,5,6
h.
j8=k+1
b43-b30,b44-b30,b50-b30,b39-b30
b48-b30,b42-b30,b46-b30,b42-b30
b49-b30,b48-b30
;texts:
;change kind impos.,,change bs device,no room,bs device unknown
;error,no resources,entry in use,no resources
;catalog error,error
w.
\f
;rc 22.05.72 fp utility, system 3, cat adm 1 ...15...
;set entry continued:
j2: al. w1 a119. ; change entry:
jd 1<11+76 ; lookup entry (name);
sn w0 0 ; if not found then
jl. j4. ; begin
j3: al w0 1 ; name conflict:
jl. j1. ; goto result 1
; end
j4: rl. w0 a127. ; check kind: w0:=kind(old entry);
rl. w1 a87. ; w1:=kind(wanted);
sl w0 0 ; if kind(old entry) < 0
sh w1 -1 ; or kind(wanted) < 0
jl. j7. ; then goto test kinds;
rl. w1 a88. ; compare device names:
sh w1 1 ; if device name(wanted) <= 1
jl. j5. ; then goto change;
dl. w1 a129. ;
sn. w0 (a88.) ; compare:
se. w1 (a89.) ; if doc name(old entry)
jl. j6. ; < >
dl. w1 a130. ; doc.name(wanted)
sn. w0 (a136.) ; then
se. w1 (a90.) ; goto change bs device error;
jl. j6. ;
j5: al. w1 a87. ; change the entry:
jd 1<11+44 ; change(old entry,wanted tail);
sn w0 0 ; if ok then
jl. b2. ; goto end program;
jl. j1. ; else goto error;
j7: sh w0 -1 ; test kinds:
sl w1 0 ; if any of the two kind >= 0
jl. j9. ; then goto change kind error;
jl. j5. ; goto change
j9: al w0 -1 ; goto
jl. j1. ; error -1;
e.
\f
;rc 21.02.74 fp utility, system 3, cat adm 1 ...16...
;the program entry
b. c22 w.
;procedure lookup entry(param)
;
;used during interpretation of the parameters. an entry with the
;name given in the item addressed by w2 is looked up in the area
;a112 to a135 (if the name is equeal to the name in the last
;lookup a new lookup is not made). if the entry is not found
;the return is to link if found the return is to link+2.
;
;
; call return
;w0 undefined
;w1 undefined
;w2 addr of item unchanged
;w3 link undefined
b. j2 w.
j0: 0 ; saved link
c0: dl w1 x2+4 ; compare name with name3:
sn. w0 (a115.) ; if first half param <>
se. w1 (a116.) ; first half name3 then
jl. j1. ; then goto lookup entry;
dl w1 x2+8 ; if second half param <>
sn. w0 (a117.) ; second half of name3
se. w1 (a118.) ; then
jl. j1. ; then goto lookup entry;
jl x3+2 ; name was old one: return to link+2;
j1: rs. w3 j0. ; lookup entry:
al w3 x2+2 ; w3:=name address;
al. w1 a119. ; w1:=address of lookup area;
jd 1<11+76 ; lookup head and tail;
rl. w3 j0. ;
sn w0 0 ; if found then
jl x3+2 ; return to link+2
jl x3 ; else return to link;
e.
;error message because param not found:
c11: jl. w3 b12. ; error message:
jl. w3 b4. ; <prog.nam> <param>
jl. w3 b37. ; unknown;
jl. b2. ; goto end program;
\f
;fgs 1981.08.05 fp utility, system 3, cat adm 1 ...17...
;entry page 2 :
;start program itself:
g6: am 1 ; entry changeentry
g5: am 1 ; entry assign
g8: al w1 0 ; entry entry
rs. w1 a27. ;
jl. w1 b0. ; start: init program;
jl. c1. ; if no left side
jl. b25. ; then goto call error;
c1: rl. w3 a1. ; move name:
dl w1 x3+4 ; move left side name
ds. w1 a111. ; to
dl w1 x3+8 ; name
ds. w1 a113. ; area no 2;
rl. w0 a27. ; if program=changeentry
sh w0 1 ; then
jl. c19. ; begin
al. w3 a110. ; w3:=name addr
al. w1 a119. ; w1:=addr lookup area
jd 1<11+76 ; lookup head and tail
sn w0 0 ;
jl. c19. ; if not found then alarm
am 1 ; 1=unknown
c16: al w0 0 ; 0=version error
rs. w0 a27. ;
jl. w3 b12. ; error message ***prog.name
jl. w3 b33. ; outspace(1)
al. w0 a110. ; outtext
jl. w3 h31.-2+10000 ; left side name
rl. w0 a27. ;
se w0 1 ;
jl. c17. ;
jl. w3 b37. ; outtext(unknown)
jl. b2. ; goto end program
; end;
c17: rl. w0 a131. ;
jl. w3 h32.-2+10000 ; outinteger(oldversion)
1<23+32<12+1 ;
jl. w3 b32. ; outcr
jl. b2. ; goto end program
; end
c19: rl. w0 a27. ;
se w0 1 ; if assign then
jl. c20. ; begin
jl. w3 b27. ; get param
jl. b80. ; if endparam then goto setentry
se. w0 (a23.) ; if not text then
jl. b13. ; alarm param
al. w1 a87. ;
al w3 x2+2 ;
jd 1<11+42 ; lookup param
se w0 0 ; if not found then
jl. c11. ; error;
rl. w0 a87. ;
sz. w0 (a138.) ; if modekind = area
jl. c22. ; then begin
rl. w0 a137. ;
rs. w0 a87. ; modekind:=bs;
dl w1 x2+4 ;
ds. w1 a89. ; move docname;
dl w1 x2+8 ;
ds. w1 a90. ; end;
c22: jl. w3 b27. ; get param;
jl. b80. ; if endparam then setentry
jl. b13. ; else alarm param
; end;
c20: jl. w3 b27. ; get kind: next compound param;
jl. b80. ; end list: goto set entry;
se. w0 (a23.) ; if not name param
jl. c4. ; then goto store kind;
dl w1 x2+4 ; search in mode.kind table:
al. w3 a26. ; index:=first of table;
c2: sn w0 (x3) ; compare: if param
se w1 (x3+2) ; <> table(index)
jl. c3. ; then goto step index;
rl w1 x3+4 ; found: w1:=table(index);
jl. c4. ; goto store kind;
c3: al w3 x3+6 ; step index: index:=index+6;
se. w3 a27. ; if not end table
jl. c2. ; then goto compare;
jl. w3 c0. ; lookup kind param: lookup entry(param);
jl. c11. ; if not found then error;
rl. w1 a127. ; w1:=kind(entry(param));
c4: rs. w1 a87. ; store kind: kind:=w1;
jl. w3 b27. ; get doc name: next comp. param;
jl. b80. ; end list: goto set entry;
se. w0 (a23.) ; if param <> name
jl. c9. ; then goto integer doc name;
rl. w1 a87. ;
sn. w1 (a103.) ; if kind = bs
jl. c5. ; then goto move doc.name;
jl. w3 c0. ; lookup entry(param);
jl. c5. ; fi not found then goto move name;
al. w2 a127. ; addr:=doc.name(entry) - 2;
c5: dl w1 x2+4 ; move doc.name:
ds. w1 a89. ;
dl w1 x2+8 ;
ds. w1 a90. ;
\f
; fgs 1982.12.17 fp utility, system 3, cat adm 1 ...18...
;entry page 3
c6: al w3 0 ; rest of tail: count:=0;
rl. w2 a2. ;
ba w2 x2+1 ; if nextsep=endsep
rl w0 x2 ; goto setclock;
sh. w0 (a25.) ;
jl. b22. ;
c7: rs. w3 c10. ; next item: save count;
jl. w3 b11. ; step pointer;
jl. b80. ; if end list then set entry;
rl. w3 c10. ; test count: get count;
sl w3 10 ; if count >= 10
jl. b13. ; then goto parameter error;
sn w3 0 ; if count=0
se. w0 (a23.) ; and sep=spacename
jl. 4 ; then
jl. w1 c21. ; goto test if date;
ba w2 x2+1 ; examine seperator:
bl w2 x2 ;
sn w2 8 ; if next seperator = point then
jl. c8. ; goto maybe left byte;
so w3 1 ; word or right byte: if count is
jl. c14. ; even then goto word;
c13: jl. w2 c12. ; store byte: get byte;
hs. w0 x3+a91. ; store byte;
al w3 x3+1 ; count:=count+1;
jl. c7. ; goto next item;
c14: jl. w2 c15. ; word: get word;
rs. w0 x3+a91. ; store word;
al w3 x3+2 ; count:=count+2;
jl. c7. ; goto next item;
c8: sz w3 1 ; maybe left byte: if count is
jl. b13. ; odd then paramerror;
jl. c13. ; goto store byte;
c9: sl w1 0 ; integer doc.name:
sl w1 2 ; if <0 or >= 2
jl. b13. ; then param error;
rs. w1 a88. ; set param in tail;
jl. c6. ; goto rest of tail;
c10: 0 ; count
b22: dl w1 110 ; set shortclock:
ld w1 5 ; save shortclock;
rs. w0 a91. ;
jl. b80. ; goto set entry;
;procedures get param byte,get param integer;
;
;if the current parameter in the fp command stack is
;an integer the value is given. if the parameter is a
;name the name is searched in the catalog and the field
;in the entry found addressed by the value of w3 is
;given.
;if the entry is not found an error exit is used.
;
;note that w2 is used as link *******
;
; call return
;
; w0 value
; w1 destroyed
; w2 link destroyed
; w3 index unchanged
b. j5 w.
j0: 0 ; saved w2 = link
j5: 0 ; saved w3
j1: bz. w0 x3+0 ; byte instruction
j2: rl. w0 x3+0 ; word instruction
c12: am j1-j2 ; get byte: instruction:=bz;
c15: bz. w0 j2. ; get word: instruction:=rl;
hs. w0 j3. ;
ds. w3 j5. ; save link,w3;
rl. w2 a2. ; get param;
bz w1 x2+1 ; if param <> name
rl w0 x2+2 ; then
se w1 10 ; w0:=value and
jl. (j0.) ; return;
jl. w3 c0. ; name: lookup entry;
jl. c11. ; not found: goto error;
dl. w3 j5. ; found: restore w2,w3;
j3: rl. w0 x3+a131. ; get word or byte (instruction set above)
jl x2 ; return
e. ; end procedure
c21:
; test if date, program entry and changeentry
b. j1 w.
rs. w1 j1. ; save return
rl w0 x2+2 ; if name<><:d:>
se. w0 (a30.) ; then
jl x1 ; return;
rl w0 x2+10 ; if nextsep<>
se. w0 (a29.) ; pointinteger then
jl x1 ; return;
rl w0 x2+14 ; w0:=nextnextsep;
rl w1 x2+16 ; clock;
sn. w0 (a29.) ; if nextnextsep<>pointinteger
jl. j0. ; then
jl. w3 c0. ; begin lookup(d);
jl. 6 ; if found then begin
rl. w3 c10. ; w3:=count;
jl. (j1.) ; return end;
al w1 0 ; clock:=0 end;
j0: rl w0 x2+12 ; date;
jl. w3 b79. ; transform date and clock
jl. b13. ; if dateerror then paramerror;
rs. w0 a91. ; save shortclock;
jl. w3 b11. ; nextparam;
am
rl w0 x2+4 ; if nextsep=pointinteger
sn. w0 (a29.) ; then
jl. w3 b11. ; nextparam;
am
rl. w3 c10. ;
al w3 x3+2 ; count:=count+2;
jl. c7. ; goto nextitem;
j1: 0 ; saved return
e.
e.
b79:
; procedure transform date and clock to shortclock
; entry exit
; w0 yymmdd shortclock
; w1 hhmm destroyed
; w2 - -
; w3 return addr if alarm then return to x3 else x3+2
b. a2, b6, c12 w.
rs. w0 b0. ; save w0
ds. w3 b1. ; save w2 w3
ba w0 2 ; w0:=date+clock;
sn w0 0 ; if date+clock=0
jl. a2. ; goto special;
al w0 0 ;
wd. w1 c0. ;
sl w0 60 ; if minutes>=60
jl. a1. ; then alarm;
sl w1 25 ; if hours>25 then
jl. a1. ; alarm
rs. w0 b2. ; save minutes
rs. w1 b3. ; save hours
al w0 0 ;
rl. w1 b0. ; yymmdd
wd. w1 c0. ;
rs. w0 b4. ; save days
sl w0 32 ; if days>=32
jl. a1. ; then alarm
al w0 0 ;
wd. w1 c0. ;
rs. w0 b5. ; save months
sl w0 13 ; if months>=13
jl. a1. ; then alarm
rs. w1 b6. ; save years
sl w1 100 ; if years>99
jl. a1. ; then alarm;
rl. w1 b6. ;
rl. w2 b5. ;
sl w2 3 ; if months<3 then
jl. a0. ; begin years:=years-1;
al w1 x1-1 ; months:=months+12;
al w2 x2+12 ; end;
a0: al w1 x1-68
wm. w1 c8. ;
as w1 -2 ; days:=(year-68)*1461/4
ba. w1 x2+c12. ; +monthstable(months)
wa. w1 b4. ; + days
wm. w1 c4. ;
wa. w1 b3. ; hours:=days*24+hours
wm. w1 c5. ;
al w2 0 ;
rl. w3 b2. ;
aa w1 6 ; min:=hours*60+min;
wd. w1 c2. ; fourmin:=min/4
wm. w0 c5. ; min:=min mod 4;
wm. w0 c9. ;
al w2 0 ; msec:=min*60*10000;
rl w3 0 ;
wm. w1 c11. ;
aa w1 6 ; clock:=fourmin*2400000+msec
jl. 4 ; special:
a2: dl w1 110 ; (clock:=rc4000clock;)
ld w1 5 ; shift(5-24) extract 24;
dl. w3 b1. ; restore w2 w3
jl x3+2 ; normal return
a1: dl. w3 b1. ; restore w2 w3
jl x3 ; alarm return
b0: 0 ; saved w0
0 ; saved w2
b1: 0 ; saved w3
b2: 0 ; minutes
b3: 0 ; hours
b4: 0 ; days
b5: 0 ; months
b6: 0 ; year
c0: 100 ;
c1: 10 ;
c2: 4 ;
c3: 15 ;
c4: 24 ;
c5: 60 ;
c6: 360 ;
c7: 365 ;
c8: 1461 ;
c9: 10000 ;
c10: 600000 ;
c11: 2400000 ;
h.c12=k-1, 0,31,59,90,120,151,181,212,243,273,304,334,365,396
e.
\f
; fgs 1982.12.17 fp utility, system 3, cat adm 1 ...19...
;the program rename:
b. c5 w.
g9: jl. w1 b0. ; start: init program;
jl. b25. ; if left side then call error;
c1: jl. w3 b11. ; next rename: next param;
jl. b2. ; end list: goto end program;
rl w1 x2+10 ;
sn. w0 (a23.) ; if del,kind <> space,name
se. w1 (a24.) ; or next del,kind <> point,name
jl. b13. ; then goto paramerror;
bz w3 x2+20 ; if second next delim
sn w3 8 ; is = point
jl. b13. ; then paramerror;
jl. w3 b11. ; next param;
ps -4 ; end list:testoutput;
al w3 x2-8 ;
al w1 x2+2 ;
jd 1<11+46 ; rename entry;
sn w0 0 ; if ok
jl. c1. ; then goto next rename;
sn w0 3 ; if result=3 then
jl. c2. ; unknown or nam.conflict;
c5: rs. w0 c3. ; error message: save result;
jl. w3 b12. ; <prog.name>
al w2 x2-10 ; <parameter>
jl. w3 b4. ;
am. (c3.) ;
bl. w1 c4. ; outtext(text(result))
jl. w3 x1+b30. ;
jl. c1. ; goto next rename;
c2: al. w1 a87. ; unknown or confl:
jd 1<11+42 ; lookup entry(old name);
se w0 0 ; if entry unknown then
al w0 3 ; result:=3 else
jl. c5. ; result:=0; goto error message;
c3: 0 ; result;
;table of result texts
h.
c4:b45-b30,b50-b30,b48-b30,b37-b30,b47-b30,b46-b30
w.
e.
\f
;rc 4.11.75 fp utility, system 3, cat adm 1 ...19a...
;the program permanent:
b. c4 w.
g10: jl. w1 b0. ; start: init program;
jl. b25. ; if left side then call error;
c1: jl. w3 b11. ; next permanent: next param;
jl. b2. ; end list: goto end program;
rl w1 x2+10 ;
sn. w0 (a23.) ; if del,kind <> space,name
se. w1 (a29.) ; or next del,kind <> point,integer
jl. b13. ; then goto paramerror;
bz w3 x2+20 ; if second next delim
sn w3 8 ; is = point
jl. b13. ; then paramerror;
jl. w3 b11. ; next param;
ps -4 ; end list:testoutput;
al w3 x2-8 ;
rl w1 x2+2 ;
jd 1<11+50 ; permanent entry;
sn w0 0 ; if ok
jl. c1. ; then goto next permanent;
rs. w0 c3. ; error message: save result;
jl. w3 b12. ; <prog.name>
al w2 x2-10 ; <parameter>
jl. w3 b4. ;
am. (c3.) ;
am -2 ;
bl. w1 c4. ; outtext(text(result))
jl. w3 x1+b30. ;
jl. c1. ; goto next permanent;
c3: 0 ; result;
;table of result texts
h.
c4:b48-b30,b37-b30,b47-b30,b46-b30,b42-b30
w.
e.
\f
; rc 76.05.31 cat adm 1 ...19b...
; setmt clearmt
s. a1, b31, c22, d3
w.
a1=99;max fileparam
g15: am 8 ; entry clear version
g14: al w0 -1<11+40; entry set version
hs. w0 d0. ; monitorcall:=remove or create entry
dl w1 x3+4 ;
ds. w1 b1. ;
dl w1 x3+8 ;
ds. w1 b2. ; save programname for error messages
sn w2 x3 ;
jl. c1. ; if no left then error1
rl w0 x2+8 ;
se w0 0 ;
jl. c1. ; if more than 9 char then error1
rl w0 x2+20 ;
rl w3 x2+30 ;
sn. w0 (b3.) ;
se. w3 (b4.) ;
jl. c2. ; if params<> name.integer then error2
bl w0 x2+34 ;
sl w0 4 ; if -,endsep then
jl. w3 d3. ; goto limits;
rl w0 x2+32 ;
sl w0 0 ;
sl w0 a1+1 ;
jl. c2. ; if max file>max fileparam then error2
rs. w0 b5. ; save max file
dl w0 x2+24 ;
ds. w0 b8. ;
dl w0 x2+28 ;
ds. w0 b9. ; set docname
dl w1 110
ld w1 5
rs. w0 b13. ; save shortclock
dl w0 x2+4 ; save given entryname
ds. w0 b21. ;
ds. w0 b24. ;
dl w0 x2+8 ;
ds. w0 b22. ;
ds. w0 b25. ;
al. w1 b6. ;
al. w2 b23. ;
c9: al w3 -16 ;
c10: rl w0 x2 ;
ls w0 x3 ;
sz w0 255 ;
jl. c11. ;
jl. c12. ;
c11: al w3 x3+8 ;
sh w3 0 ;
jl. c10. ;
al w1 x1+2 ;
al w2 x2+2 ;
jl. c9. ;
c12: ac w3 x3 ;
rs. w3 b26. ;
ds. w2 b28. ;
al w3 x3-8 ;
sl w3 0 ;
jl. c13. ;
al w3 16 ;
al w1 x1+2 ;
al w2 x2+2 ;
jl. 4 ;
c13: al w2 x1 ;
rs. w3 b29. ;
ds. w2 b31. ; save words and shifts for entryno.
am -2 ;
al. w3 b8. ;
al. w1 c19. ;
jd 1<11+42 ; lookup docname param
se w0 0 ; if found then
jl. c6. ; begin
rl. w0 c19. ;
rs. w0 b7. ; move modekind
dl. w0 c20. ; move docname
ds. w0 b8. ; from
dl. w0 c21. ; lookuparaea
ds. w0 b9. ;
rl. w3 c22. ; move fileno
ba. w3 d1. ; add fileno
hs. w3 d1. ; end;
c6: al. w3 b6. ;
d1=k+1
al w2 1 ;
rs. w2 b10. ;
d2=k+1
al w2 1 ; file:=1
c0: rs. w2 b11. ; om:save file
al w1 0 ;
wd. w2 b12. ;
se w2 0 ;
jl. c14. ;
al w2 x1 ;
al w1 -48 ;
c14: al w1 x1+48 ;
al w2 x2+48 ;
ls. w2 (b26.) ;
lo. w2 (b28.) ;
rs. w2 (b27.) ;
ls. w1 (b29.) ;
lo. w1 (b31.) ;
rs. w1 (b30.) ; set entryno. in entryname
al. w1 b7. ;
d0=k+1 ; monitor call will be either
jd 1<11+48; create or remove entry depending on entry
sn w0 0 ; of program
jl. c16. ;
al w1 8 ;
sz. w1 (d0.) ;
jl. c15. ; if setmt then goto createerror
sn w0 3 ; removeerror:
jl. c3. ; if not found then error3
jl. c4. ; else error4
c15: ; createerror:
sn w0 4 ;
jl. c5. ; if no resources then error5
se w0 3 ;
jl. c4. ; if no name conflict then error4
al. w3 b6. ; w3:=name addr
jd 1<11+48; remove old entry
se w0 0 ;
jl. c4. ; if remove not pos. then error4
al. w1 b7. ; w1:=tail addr
jd 1<11+40; create entry
se w0 0 ; if not ok then
jl. c15. ; goto createrror
c16: rl. w2 b10. ;
al w2 x2+1 ; file:=file+1
rs. w2 b10. ;
rl. w2 b11. ;
al w2 x2+1 ;
sh. w2 (b5.) ;
jl. c0. ; if file <=max file then om
jl. c8. ; else exit
d3: sn. w0 (b4.) ; if nextsep<>pointint
jl. c2. ; then alarm2;
rl w0 x2+32 ;
hs. w0 d1. ;
hs. w0 d2. ; save lower limit;
bl w0 x2+38 ;
sl w0 4 ; if nextsep<>endparam
jl. c2. ; then alarm2;
rl w0 x2+36 ; if lower>upper
ws w0 x2+32 ; then alarm2;
sh w0 -1 ;
jl. c2. ;
rl w0 x2+36 ; maxparam;
jl x3+2 ; return
b0:<:***:> ; progname for error messages
0
b1:0
0
b2:0
h.
b3:4,10 ; sp.name
b4:8,4 ; point.integer
w.
b5:0 ; max file
b6:0 ; entry name var
b21:0
0
b22:0
b7:1<23+18 ; tail
0
b8:0 ; docname
0
b9:0
b13:0 ; shortclock
b10:0,r.4 ; file
b11:0
b12:10
b23:0 ; entryname bas
b24:0
0
b25:0
b26:0
b27:0
b28:0
b29:0
b30:0
b31:0
b14:<: call<10><0>:> ; errortext 1, used by both
b15:<: param<10>:> ; errortext 2, used by both
b16:<: unknown<10><0>:> ; errortext 3, used by clearmt
b17:<: catalog error<10><0>:>; errortext 4, used by both
b18:<: no resources<10>:>; errortext 5, used by setmt
c1: am b14-b15; error1
c2: am b15-b16; error2
c3: am b16-b17; error3
c4: am b17-b18; error4
c5: al. w0 b18. ; error5
rs. w0 c18. ; select errortext
al. w0 b0. ;
am -2048
jl. w3 h31.-2+12048 ; write program name
rl. w0 c18. ;
sh. w0 b15. ;
jl. c17. ; if error>2 then
al w2 32 ; begin
am -2048
jl. w3 h26.-2+12048 ; writesp
al. w0 b6. ; writetext entryname
am -2048
jl. w3 h31.-2+12048 ; end;
c17: rl. w0 c18. ;
am -2048
jl. w3 h31.-2+12048 ; write errortext
al. w3 b6. ; w3:=name addr.
rl. w0 c18. ; if error3 then
sn. w0 b16. ; goto next file
jl. c16. ;
c7: am 1 ; errorexit: sorry:=1
c8: al w2 0 ; exit: or 0
am -2048
jl. w3 h7.+12048; fpexit
c18: 0 ; saved error text addr
c19: 0 ; lookup area
0 ; docname
c20: 0 ;
0
c21: 0
0
c22: 0
e.
g2=k-g3
\f
;rc 78.03.18 fp utility, cat adm 1 ...20...
;working locations:
a110: 0 ; name area 2
a111: 0 ;
a112: 0 ;
a113: 0 ;
a114: 0 ;
a119: 0 ; entry area: start of head
a120: 0 ; interval lower
a121: 0 ; interval upper
a115: 0 ; name area 3
a116: 0 ;
a117: 0 ;
a118: 0 ;
a127: 0 ; tail: kind
a128: 0 ;
a129: 0,r.2 ;
a130: 0 ;
a131: 0 ;
a132: 0 ;
a133: 0 ;
a134: 0 ;
a135: 0 ;
a137: 1<23+4 ; bs-code
a138: 1<23 ; sign bit
\f
;fgs 1984.06.18 cat adm 1, tails
i.
m.rc 1984.06.18 fp utility, sys 3, cat adm 1
m. set,setmt,clearmt,entry,changeentry,assign,rename,permanent,nextfile
e.
w.
g0: (:g2+511:)>9 ; entry set
0,r.4
s2 ; month year
0,r.2
2<12+g7-g3
g2
1<23+4 ; entry setmt
0, r.4
s2 ; date
0, 0
2<12+g14-g3
g2
1<23+4 ; entry clearmt
0, r.4
s2
0,0
2<12+g15-g3
g2
1<23+4 ; entry entry
0,r.4
s2 ; month year
0,r.2
2<12+g8-g3
g2
1<23+4 ; entry changeentry
0, r.4
s2 ; date
0, r.2
2<12+g6-g3
g2
1<23+4 ; entry assign
0, r.4
s2 ; date
0,0
2<12+g5-g3
g2
1<23+4 ; entry rename
0,r.4
s2 ; month year
0,r.2
2<12+g9-g3
g2
1<23+4 ; entry permanent
0,r.4
s2 ; date
0,0
2<12+g10-g3
g2 ; length
g1: 1<23+4 ; entry nextfile
0,r.4
s2 ; month year
0,r.2
2<12+g11-g3
g2
\f
d.
p.<:insertproc:>
l.
e.
▶EOF◀