DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦3910e5d35⟧ TextFile

    Length: 52992 (0xcf00)
    Types: TextFile
    Names: »set4tx      «

Derivation

└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
    └─⟦75ff9bef3⟧ 
        └─⟦this⟧ »set4tx      « 

TextFile

                                                                                             
\f



; fgs 1988.19.13                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 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. a300, 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


; fgs 1988.12.20                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, shortest name
a24: 8<12+10        ; point, shortest name
a223:4<12+ 9        ; space, nearly  name
a123:4<12+(:7*8+10:); space, longest name
a124:8<12+(:7*8+10:); point, longest name
a28: 4<12+4         ; space, integer
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 198.05.06            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 ; mt,             high density, odd  parity
    <:mte:>,0  ,  1<23+ 2<12+18 ;                               even 
    <:nrz:>,0  ,  1<23+ 4<12+18 ;                 low         , odd  
    <:nrze:>   ,  1<23+ 6<12+18 ;                               even 
    <:mtlh:>   ,  1<23+ 0<12+18 ;     low  speed, high        , odd  
    <:mtll:>   ,  1<23+ 4<12+18 ;                 low                
    <:mthh:>   , 1<23+128<12+18 ;     high speed, high               
    <:mthl:>   , 1<23+132<12+18 ;                 low                
    <:mt62:>   ,  1<23+ 0<12+18 ;                 6250 bpi           
    <:mt16:>   ,  1<23+ 4<12+18 ;                 1600               
    <:mt32:>   ,  1<23+ 8<12+18 ;                 3200               
    <:mt08:>   ,  1<23+12<12+18 ;                  800               
    <: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


; fgs 1988.12.20             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 (a123.)        ;   if next del <> point
     jl.    (j0.)          ;   then return to link+2;
     sn. w0 (a28.)        ;   if      param <> space, integer
     se. w3 (a29.)        ;   or next param <> point, integer then
     jl.     b13.         ;     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


; fgs 1988.11.30             fp utility, system 3, cat adm 1 ...13...

;the program set
;
b. c11 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;
     sh. w0 (a123.)        ;   if param > 4 < 12 + longest name
     sh. w0 (a223.)        ;   or param < 4 < 12 + shortest name
     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;
     sh. w0 (a123.)        ;   if param > 4 < 12 + longest name
     sh. w0 (a223.)        ;   or param < 4 < 12 + shortest name
     jl.     c5.           ;   then goto integer doc.name;
     dl  w1  x2+4          ;   move doc.name:
     ds. w1  a89.          ;
     dl  w1  x2+8          ;
     ls  w1 -8             ;   zero last char
     ls  w1  8             ;   of last word in name;
     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
     sh. w0 (a123.)  ;   if param > 4 < 12 + longest name
     sh. w0 (a223.)  ;   or param < 4 < 12 + shortest name
     jl.     c10.    ;     goto not name else
     jl.     c0.     ;     goto test if date;
c10: 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;
     sh. w0 (a123.)        ;   if param > 4 < 12 + longest name
     sh. w0 (a223.)        ;   or param < 4 < 12 + shortest name
     jl.     c11.          ;     goto not name else
     jl.     b13.          ;     goto paramerror;
c11: rl. w3  c7.           ;   if nextsep = endsep then
     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  4             ;   if doc.name < 0 or >= 4
     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 1988.10.13             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
     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
     sh. w0 (a123.)        ;   if param > 4 < 12 + longest name
     sh. w0 (a223.)        ;   or param < 4 < 12 + shortest name 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;
     sh. w0 (a123.)        ;   if param > 4 < 12 + longest name
     sh. w0 (a223.)        ;   or param < 4 < 12 + shortest name
     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;
     sh. w0 (a123.)        ;   if param > 4 < 12 + longest name
     sh. w0 (a223.)        ;   or param < 4 < 12 + shortest 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 1988.11.30             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;
     se  w3  0             ;   if count <> 0 then
     jl.     c16.          ;     examine separator;
     sh. w0 (a123.)        ;   if param > 4 < 12 + longest name
     sh. w0 (a223.)        ;   or param < 4 < 12 + shortest name
     jl.     c16.          ;     goto eamine separator;
     jl. w1  c21.          ;   test if date;
c16: ba  w2  x2+1          ; examine separator:
     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  4             ;   if <0 or >= 4 
     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
     sh  w1  9             ;   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 1988.12.20 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◀