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

⟦70ba8776a⟧ TextFile

    Length: 75264 (0x12600)
    Types: TextFile
    Names: »mons2«

Derivation

└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ.  Detaljer om "HC8000" projekt.
    └─⟦0364f57e3⟧ 
        └─⟦d53069465⟧ »kkmon2filer« 
            └─⟦this⟧ 
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
    └─⟦4334b4c0b⟧ 
        └─⟦f874557f7⟧ »kkmon2filer« 
            └─⟦this⟧ 

TextFile

\f


m.                mons2 - monitor operatins system s, part 2

b.i30 w.
i0=81 05 05 , i1=13 00 00

; if newtime (i0,i1) > oldtime (a133,a134) then oldtime:=newtime;
c.i0-a133
c.i0-a133-1, a133=i0, a134=i1, z.
c.i1-a134-1,          a134=i1, z.
z.

i10=i0, i20=i1

i15=i10/100000 , i10=i10-i15*100000 , i25=i20/100000 , i20=i20-i25*100000 
i14=i10/10000  , i10=i10-i14*10000  , i24=i20/10000  , i20=i20-i24*10000 
i13=i10/1000   , i10=i10-i13*1000   , i23=i20/1000   , i20=i20-i23*1000
i12=i10/100    , i10=i10-i12*100    , i22=i20/100    , i20=i20-i22*100
i11=i10/10     , i10=i10-i11*10     , i21=i20/10     , i20=i20-i21*10

i2:<:                              date  :>
(:i15+48:)<16+(:i14+48:)<8+46
(:i13+48:)<16+(:i12+48:)<8+46
(:i11+48:)<16+(:i10+48:)<8+32

(:i25+48:)<16+(:i24+48:)<8+46
(:i23+48:)<16+(:i22+48:)<8+46
(:i21+48:)<16+(:i20+48:)<8+ 0

i3:  al. w0      i2.     ; write date:
     rs  w0  x2  +0      ;   first free:=start(text);
     al  w2       0      ;
     jl      x3          ;   return to slang(status ok);

     jl.         i3.     ;
e.
j.


w.e0: c0     ; <first addr>
;e1        ; defined below

e2:c4     ; <own buf>
e3:c5     ; <own area>
e4:0      ; <max device>
e5:h0     ; <char table>
e6:h1     ; <param table>
e7:h2     ; <first command>
e12:h3    ; <top command table>
e8:0-0-0  ; <last of initcat code>
e9:h4     ; <first console>
e10:h5     ; <last console>
e11:h6     ; <first device>
e13:h8     ; <first work>
e14:h9     ; <last work>
e33:h10    ; fictive element before first core table
e15=k-c20
e15,e15
e16:h11    ; <first core>
e17:0      ; <top core>
e18:0      ; <param type>
e19:0      ; <integer>
e24:h8     ; <work>  ( initially: first work )
; *** the following variables must match part of work-area
e20:0      ; <name>
e21:0      ;
e22:0      ;
e23:0      ;
0
e78:0 ; used in list
e79:-1  ; segment in susercat or -1
e81:0      ;remove,1<21 indicator 
e25:h21    ; <console>  ( initially: first console )
e26:0      ; <console buf> or <last addr>
e27:8      ; <char shift>  (initially: prepared for empty char buf)
e28:0      ; <char addr>
e29:0      ; <child>
e30:0      ; <core addr>
; *** end of work-area match
e31:h21

e34:0
e35=k-c20
h4,h22
e36:
e37:0
e38:0
e32:0,r.8  ; <message>

e88:0      ; expected answer
e89:0      ; executing reentrant code: 0=false, -1=true (initially = false)

e39:0      ; <event>
e40:0      ; <receiver>
e41:0      ;
e42:0      ;
e43:0,0    ; 
e55:0      ; <write shift>
e44:5<12   ; <type mess>
e45:0      ; <line addr>
e46:0      ; <write addr>
0
e47:3<12   ; <area mess> or <input mess>
e48:0      ; <first addr>
e49:0      ; <last addr>
e50:0      ; <segment>
e87: 0                  ; areabuf state: 0=defined, else undef (initially defined)
e51:0      ; <entry tail> or <answer> or <message>
e52:0      ;
e53:0      ;
e54:0      ; <convert area>
0
e56:0      ; <read shift> or <radix> or <start>
e57:0      ; <read addr> or <state> or <size>
e58:0      ; <save w1> or <first segment>
e59:0      ; <save w2> or <content> or <keys> or <result>
e60:0      ; <link> or <bytes to load>
e61:0      ; <child w0>
e62:0      ; <child w1>
e63:0      ; <child w2>
e64:0      ; <child w3>
e65:0      ; <child ex>
e66:0      ; <child ic>
e67=e59+1  ; <ic in entry>
e68=e66+2
0,0
e69:0     ;jobcount
c.(:c23>14 a.1:)-1
e70:h19
e71:h20
z.
m.         s lock indicator.
c.(:c23>13 a.1:)-1     ; if teminals shal be blocked after start up
e80: -1                ; then e80=-1, else
z.
c.-(:c23>13 a.1:)      ;
e80: 0                 ; e80=0
z.
e85:0   ; used in job command

; end line:
e1=e17-a17;********************
g1:  jl. w1     g28.     ;
g48=k+4
<:ready  **date not initialized <0>:>   ; text until date initialized  
g2:  jl. w1     g28.     ;
<:syntax error:<0>:>
g3:  jl. w1     g28.     ;
<:not allowed<0>:>
g4:  jl. w1     g28.     ;
<:no core<0>:>
g5:  jl. w1     g28.     ;
<:no buffers<0>:>
g6:  jl. w1     g28.     ;
<:no areas<0>:>
g7:  jl. w1     g28.     ;
<:no internals<0>:>
g8:  jl. w1     g28.     ;
<:key trouble<0>:>
g9:  jl. w1     g28.     ;
<:process unknown<0>:>
g10: jl. w1     g28.     ;
<:process exists<0>:>
g11: jl. w1     g28.     ;
<:catalog error<0>:>
g12: jl. w1     g28.     ;
<:area unknown<0>:>
g13: jl. w1     g28.     ;
<:area reserved<0>:>
g14: jl. w1     g28.     ;
<:program too big<0>:>
g15: jl. w1     g28.     ;
<:area error<0>:>
g16: jl. w1     g28.     ;
<:device unknown<0>:>
g17: jl. w1     g28.     ;
<:device reserved<0>:>
g18: jl. w1     g28.     ;
<:not implemented<0>:>
g19: jl. w1     g28.     ;
<:base illegal<0>:>
g20: jl. w1     g28.     ;
<:bs claims exceeded<0>:>
g21: jl. w1     g28.     ;
<:bs device unknown<0>:>
g22: jl. w1     g28.     ;
<:name unknown<0>:>
g23:<:message<0>:>
g24:<:pause<0>:>
g25: jl. w1     g28.     ;
<:no entries in maincat<0>:>
g26:<:max<0>:>
g27: jl. w1     g28.     ;
<:illegal priority<0> :>
g29: jl. w1     g28.     ;
<:prog name unknown<0>:>
g47: jl. w1     g28.   ;
<:input aborted<0>:>

g28:
     ld  w3    -100      ; w2=w3=0
     se  w3  (b13)      ; if clock initialized then
     rs. w3  g48.       ; remove warning
     sn. w1      g2.+2   ; if 'syntax' then
     al  w2      10      ; set w2=10
     se. w1      g1.+2   ; else
     hs. w3     e81.     ; reset remove indicator
     al  w3      -1      ;
     rs. w3     e89.   ;   executing reentrant code := true;
     rs. w3     e79.     ; reset segment no in susercat
     jl. w3     d19.     ; init write
     jl. w3     d21.     ; write text
     se  w2      10      ; if syntax error  then
     jl.        g46.     ;
     al. w1     e20.     ; write last read parameter
     jl. w3     d21.     ;
     rl. w1     e19.     ;
     rl. w0     e20.     ;
     sn  w0       0
     jl. w3     d22.     ;
g46: al  w0      10      ;
     jl. w3     d20.     ; write <nl>
     jl. w3     d23.     ; type line
     jl. w3     d42.     ;   save work(buf);
     jl.          2      ;+2:  error
     rl. w1     e25.     ;
     jl. w3     d10.     ; decrease access

g30: al  w2       0      ; exam first:
     rs. w2     e81.   ;   reset remove list indicator
     jl.        g32.     ;   event:=0;
g31: rl. w2     e39.     ; exam next:
g32: jd     1<11+24      ;   wait event(event,next,result);
     rs. w2     e39.     ;   event:=next;
     rl  w1  x2  +6      ;   sender:=word(event+6);
c.(:c24>20a.1:)-1       ;   if event testoutput then
     jd     1<11+30      ;   begin type w1(sender);
     jd     1<11+32      ;         type w2(event);
z.                      ;   end;
     sz. w2    (e89.)  ;   if executing non-reentrant code
     jl.        g41.   ;     and
     se. w2    (e88.)  ;     event <> expected answer then
     jl.        g32.   ;     goto exam next;
g41:                   ;
     sn  w0       0      ;   if result=0 then
     jl.        g34.     ;   goto message received;
     jl. w3     d41.   ;   find work(event,old work);
     al. w1     e51.     ; answer received:
     jd     1<11+18      ;   wait answer(event,answer,result)
     al  w3       1      ;   w1 := logical status
     ls  w3      (0)     ;      := 1 shift result
     sn  w3     1<1      ;       + maybe status.answer;
     lo  w3  x1          ;
     rs. w3     e59.     ;
     jl. w3     d43.     ;   restore work(work,event);

g33: rl. w2     e39.     ; reject message:
     jd     1<11+26      ;   get event(event);
     al  w0       2      ;
     al. w1     e51.     ;
     jd     1<11+22      ;   send answer(event,answer,2);
     jl.        g30.     ;   goto exam first;

g34: rl. w3      e2.     ; message received:
     sh  w3       1      ;   if own buf<=1
     jl.        g31.     ;   then goto exam next;
     sh  w1      -1      ;   if sender<0
     jl.        g33.     ;   then goto reject message;
     sn  w0 (x1  +0)     ;   if kind(sender)=0
     jl.        g50.     ;   then goto internal message;
     al  w0  x1          ;
     jl. w3     d24.     ;   find console(device,console,
     jl.        g33.     ;                reject message);
     rs. w1     e25.     ;   console:= new console
     jl. w3      d9.     ; increase access


     jd     1<11+26      ;   get event(console buf);
     al  w0       1      ;
     al. w1     e51.     ;
     jd     1<11+22      ;   send answer(console)
     al  w2       0      ;
     jl. w3     d41.     ;   find work(0,new work);
     al  w0  x1+c73    ;   input stack pointer := stack base;
     rs  w0  x1+c58    ;
g39:                   ;     end;
     al  w2  x1+c66      ;   first addr:= work+linebuf;
     al  w3  x1+c67      ;   last addr:= work+outputlinebuf-2;
     ds. w3     e49.     ;
     al. w1     e47.     ;
     jl. w3     d26.   ;   send buf (input mess, buf);
     jl. w3     d42.     ;   save work(buf);
     jl.         g47.    ;+2:  error:  goto end line;
     al  w2  x1+c66-2  ;   char shift := > 0; (* i.e. change word *)
     ds. w2     e28.   ;   char addr := work + linebuf - 2;
     wa. w2     e52.   ;
     rs. w2     e26.   ;   last addr := char addr + bytes;
; next command:
g35: jl. w3      d2.     ;   next param(type);
g36: sn  w0       0      ; exam command:
     jl.         g98.     ;   if type=0
     se  w0       1      ;   or type<>1
     jl.         g2.     ;   then goto end line;

     jl. w3     d19.   ;   init write;
     al  w3    -1      ;
     rs. w3     e89.   ;   executing reentrant code := true;

     rl. w3      e7.     ;   w3 := base of command table;
g37:; next command:
     al  w3  x3  +6      ;   increase (command pointer);
     dl  w2  x3  +2      ;   w1w2 := command name;
     sh  w1       0      ;   if first of command <= 0 then
     jl.        g38.     ;     goto test end;
     sn. w1    (e20.)    ;   if command.table <> name then
     se. w2    (e21.)    ;
     jl.        g37.     ;     goto next command;
; notice:  only 6 first characters tested

; command found in table:
; test that it is allowed to call this command from this console

     al  w2       0      ;
     rl  w3  x3  +4      ;

     ld  w3      10      ; w0:= command mask.console
     ls  w3     -10      ; w1:= console
     rl. w1     e25.     ; w2:= command bits.command table
     bz  w0  x1+c27      ; w3:= relative command address
     so  w2       1      ; if command not list max print or modify then
     hs. w2     e81.+1   ; remove console=false
     ls  w2      -1      ;
     ls  w2       3      ;
     sz  w0     1<3      ; if console privileged then
     jl.        g40.     ; goto command base
     so  w0  x2          ; if command not allowed(console) then
     jl.         g3.     ; goto end line
     so. w2    (e80.)    ; if locked and not a bit 3 command then
     jl.         g3.     ; goto end line

g40: jl.     x3+g45.     ;   goto command-action;
; init write has been called
; w0 = command mask(console)
; w1 = console

g38:; test found:
     sn  w1       0      ;   if continuation = 0 then
     jl.         g2.     ;     goto end line;  i.e. all commands tested

; all commands, not contained in primary part of command table, are
; considered non-reentrant

     al  w3     0      ;
     rs. w3     e89.   ;   executing reentrant code := false;


     ac  w3  x1  +6      ;   w3 := continuation address for more commands;
;   (notice w3 = base of commands)
     jl.        g37.     ;   goto next command;

g98: rl. w1     e24.      ; if stack=stackbase then
     rl  w2  x1+c58       ; goto endline else
     sn  w2  x1+c73       ; goto next command
     jl.         g1.      ;
     jl.        g35.      ;



g50:; message:
     dl  w0  x2 +10      ;
     ds. w0     e32.+2   ;   move message from buffer to <message>;
     dl  w0  x2 +14      ;
     ds. w0     e32.+6   ;
     dl  w0  x2 +18      ;
     ds. w0     e32.+10  ;
     dl  w0  x2 +22      ;
     ds. w0     e32.+14  ;
     al  w2  x1  +0      ;
     jl. w3     d25.     ;   find parent(sender,parent,
     jl.        g33.     ;                  reject message);
     rs. w1     e25.     ;   console:= parent;
     rs. w2     e29.     ;   child:= sender;
     al  w2       0      ;
     jl. w3     d41.     ;   find work(0,new work);
     jl. w3     d19.     ;   init write;
     rl. w3     e32.     ;   if message(0)(23)=1 then
     so  w3       2.1    ;     begin stop child;
     am     d33-d39      ;       writetext(<:pause:>)
     jl. w3     d39.     ;     end
     se. w3       0      ;   else
     am     g24-g23      ;     begin child name;
     al. w1     g23.     ;       writetext(<:message:>)
     jl. w3     d21.     ;     end;
     rl. w2     e39.     ;
     jd     1<11+26      ;   get event(event);
     al  w0       1      ;
     al. w1     e32.     ;
     jd     1<11+22      ;   send answer(event,message,1);
     al. w1     e40.     ;
     jl. w3     d21.     ;   writetext(receiver);
     al. w2     e32.+2   ;   index:= 2;
g43: rl  w1  x2  +0      ; next word:
     bl. w3     e32.+1   ;   word:= message(index);
     ls  w3       1      ;   bits:= message(1);
     hs. w3     e32.+1   ;   message(1):= bits shift 1;
     sh  w3      -1      ;   if bits(0)=1 then
     jl.        g44.     ;   goto number;
     sn  w1       0      ;   if word=0 then
     jl.        g42.     ;   goto test more;
     al  w0       0      ;   char:= word(0:7);
     ld  w1       8      ;   word:= word shift 8;
     jl. w3     d20.     ;   writechar(char);
     al  w0       0      ;   char:= word(0:7);
     ld  w1       8      ;   word:= word shift 8;
     jl. w3     d20.     ;   writechar(char);
     al  w0       0      ;   char:= word(0:7);
     ld  w1       8      ;   word:= word shift 8;
     am     d20-d22      ;   writechar(char);
;   goto test more;
; number:
;   writeinteger(word);
g44: jl. w3     d22.     ; test more:
g42: al  w2  x2  +2      ;   index:= index+2;
     sh. w2     e32.+14  ;   if index<=14 then
     jl.        g43.     ;   goto next word;
     al  w0      10      ;
     jl. w3     d20.     ;   writechar(10);
     jl. w3     d23.     ;   typeline(buf);
     rs. w2     e23.+2   ; clear function
     zl. w1     e32.+1   ; if stop bit on then
     so  w1     8.200    ; begin
     jl.        g97.     ;
     zl. w1     e32.     ; save function
     rs. w1     e23.+2   ;
     se  w1     10       ; if function = replace then
     jl.        g97.     ;  save areaname
     rl. w3     e24.     ; save name in input buffer
     al  w3  x3+c66      ;
     dl. w1     e32.+10  ;
     ds  w1  x3+2        ;
     dl. w1     e32.+14  ;
     ds  w1  x3+6        ; end
     dl. w1     e26.     ; simulate empty input string
     ds. w1     e28.     ; ( after unstack command)
g97: jl. w3     d42.     ; save work
     am          0       ; +2 error (dont care)
     rl. w3     e23.+2   ; if function =finis or replace then
     se  w3     10       ;
     sn  w3      2       ; 
     sz                  ;
     jl.        g30.     ;
     jl. w3     d76.     ; adjust bs claim
     jl. w3     d40.     ; remove process
     rl. w3     e23.+2   ; if function =replace then
     se  w3     10       ;
     jl.        g30.     ;
     rl. w2     e24.     ; stack input and
     al  w2  x2+c66      ;
     jl. w3     d79.     ; goto next command
     jl.        g35.     ;

g45: ; base for command-relatives

; define pseudo-entries for conditinally-assembled commands
g70: ; break
g72: ; include
g73: ; exclude
g74: ; call
g75: ; list
g76: ; max
g77: ; replace
g83: ; all
g89: ; job
g90: ; print
g91: ; modify
     jl.        g18.   ;   goto not implemented;



; command syntax:  read <area name>
g57:                   ; read:
     jl. w3     d15.   ;   next name;
     al. w2     e20.   ;
     am        -2048   ;
     jl. w3     d79.+2048;   stack input (name);
     jl.        g35.   ;   goto next command;


; command syntax:  unstack
g58:                   ; unstack:
     am        -2048   ;
     jl. w2     d80.+2048;   unstack input;
     jl.        g35.   ;   goto next command;


; command syntax:  date <year> <month> <date> <hour> <min> <sec>

b. i20, j30 w.         ;
j0:                    ; minimum values:
     81  ,  1  ,  1  ,  0  ,  0  ,  0
j1:                    ; top values:
     99+1, 12+1, 31+1, 23+1, 59+1, 59+1
j2:                    ; year,month,day,hour,min,sec
      0  ,  0  ,  0  ,  0  ,  0  ,  0
j5:                    ; month table: jan, ..., dec
h. 365, 396, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334
w.
j11: 4                 ; minutes per four minutes
j13: 24                ; hours per day
j14: 60                ; minutes per hour
j17: 365*3+366         ; days per four years (inclusive leap year)
j18: 10000             ; units per second
j20: 60*4 * 10000      ; units per four minutes

j30: <:oldcat:>        ; name of successor-command

g49:                   ; date:
     al  w1     0      ;   for i := 0 step 2 until 10 do
i0:                    ;     begin
     jl. w3     d16.   ;     next integer;
     sl. w0 (x1+j0.)   ;     if number < min value
     sl. w0 (x1+j1.)   ;     or number >= top value then
     jl.        g2.    ;       goto syntax error; (* i.e. illegal date *)
     rs. w0  x1+j2.    ;     save number;
     al  w1  x1+2      ;
     se  w1     12     ;
     jl.        i0.    ;     end;

     dl. w2     j2.+2  ;   w1 := year; w2 := month;
     sh  w2     2      ;   if month > february then
     al  w1  x1-1      ;     year := year - 1;

     al  w1  x1-68     ;   days := (year - 68)
     wm. w1     j17.   ;     * days in four years
     as  w1    -2      ;     / 4
     ba. w1  x2+j5.-1  ;     + month table (month)
     wa. w1     j2.+4  ;     + day;

     wm. w1     j13.   ;   w1 := hours := days * 24
     wa. w1     j2.+6  ;     + hour;

     al  w2     0      ;   w2w3 := min;
     rl. w3     j2.+8  ;

     wm. w1     j14.   ;   w0w1 := minutes := hours * 60
     aa  w1     6      ;     + min;

     wd. w1     j11.   ;   w1 := fourmin := minutes / 4;
     wm. w0     j14.   ;   seconds := minutes mod 4 * 60
     wa. w0     j2.+10 ;     + sec;

     wm. w0     j18.   ;   msec := seconds * 10000;
     rl  w3     0      ;   (w2=0) w3 := msec;

     wm. w1     j20.   ;   clock := fourmin * 2400000
     aa  w1     6      ;     + msec;
     jd         1<11+38;   set clock (clock);

     dl. w1     j30.+2 ;   name := successor command name;
     ds. w1     e21.   ;
     al  w0     1      ;   type := 1;  <* i.e. pretend that 'oldcat' has been read *>
     sl  w0    (b25)   ;   if maincat not defined yet then
     jl.        g36.   ;     goto next command; <* i.e. interpret 'oldcat' *>

     jl.        g35.   ;   goto next command;

e.                     ;


b.i30 w.                ; new:
g51:
     la. w0      i0.     ;   abs addr(console):= all bs(console):=
                         ;   abs protection(console):=false;
     rs  w0  x1+c26      ;   prio(console):= 0;
     hs  w0  x1+c37      ;   pr(console):=illegal pr;
     dl. w3      i2.     ;   buf claim(console):=standard buf;
     ds  w3  x1+c34      ;   area claim(console):=standard area;
     rl. w3      i3.     ;   internal claim(console):=standard int;
     rs  w3  x1+c39      ;   cat mask(console):=standard cat;
     rl. w0      i9.     ;
     rl. w3      i9.     ;
     ds  w0  x1+c41+2    ; max interval(console):=max interval(s)
     ds  w0  x1+c42+2    ; standard interval(s)
     ds  w0  x1+c43+2    ;
     jl. w3     d46.     ;   clear claimlist;
     rl. w2     i25.     ; get work device name
     jl. w3     d61.     ; get devno*8
     jl.        g16.     ; sorry goto end line
     wa. w2     e25.   ;
     dl. w0     i6.    ;   perm claim(work device) :=
     ds  w0  x2+c44+6  ;     standard segment,entries;
i10: dl. w3      i4.     ;   size(console):=standard size;
     rl. w1     e25.     ;
     ds  w3  x1+c40+2    ;
     dl. w3      i5.     ;
     ds  w3  x1+c40+6    ;   prog(console):=standard prog;
     al  w0     0      ;
     rs  w0  x1+c95+2  ;   clear primary input name;
     rs  w0  x1+c96+2  ;   clear primary output name;
     jl.        g52.     ;   goto process;
i0:8.1771            ;
c7<12+c8          ; standard buf and area:
i2:c9<12+c10         ; standard int and func:
i3:c12               ; standard size:
i4=k+2, i5=k+6        ; standard prog:
<:fp:>,0,0,0      ;
c13               ; standard segment claim
i6:c14               ; standard entry claim
i8:8.2000            ; all bs resources bit
i9:8388605
i25:   c15               ; work device name
c.    (:c23>16a.1:)-1    ;

g83 = k                ; all:
     la. w0      i0.     ; abs addr(console):=
     lo. w0      i8.     ; abs prot(console):= false
     rs  w0  x1+c26      ; all bs(console):= true
     rl  w2      b1      ;
     dl  w0  x2+a45      ;
     ds  w0  x1+c41+2    ; maxbase:=standardbase(s)
     ds  w0  x1+c42+2    ; standardbase:=  ------
     ds  w0  x1+c43+2    ; userbase:=  -------
     bz  w0  x2+a19      ; bufclaims(s)
     ws. w0      e2.     ; - ownbuf
     hs  w0  x1+c32      ; =: bufclaims(console)
     bz  w0  x2+a20      ; areaclaims(s)
     ws. w0      e3.     ; - own area
     hs  w0  x1+c33      ; =: areaclaims(console)
     bz  w0  x2+a21      ; internalclaims(s)
     bs. w0       1      ; -1
     hs  w0  x1+c34      ; =:internalclaims(console)
     bz  w0  x2+a22      ; functionmask(s)
     hs  w0  x1+c35      ; =: functionmask(console)
     jl. w3     d29.     ; find max(size)
     sn  w1       0      ; if max size =0 then
     jl.         g4.     ; return  "no core "
     rl. w2     e25.     ;
     rs  w1  x2+c39      ; size(console):= size
c.-4000                  ; only in rc4000:
     al  w2       8      ; keys:= 8
     jl. w3     d32.     ; find keys(keys,pr,pk,notused)
     am           0      ;
     ac  w0  x2  -8      ;
     rl. w1     e25.     ;
     hs  w0  x1+c26      ; keys(console):= 8-keys
z.                       ;
;
;
     jl. w3      d46.    ;   clear claimlist;
     jl.        i10.     ;
z.                       ;
e.
b. j5 w.
g94: am  c95-c96        ; i:
g95: al  w1  x1+c96+2   ; o:
     jl. w3  d16.       ; get kind
     rs  w0  x1-2       ;
     jl.     j1.        ; continue with get name

g52: am     c29-c40      ; process:
g53: al  w1  x1+c40      ; program:
 j1: jl. w3     d15.     ;   next name;
     rl. w3      j2.     ; test name
     sn. w3    ( e20.)   ; if name="s"
     jl.          g3.    ; then goto error : not allowed
     dl. w3     e21.     ; 
     ds  w3  x1  +2      ;
     dl. w3     e23.     ;
     ds  w3  x1  +6      ;   name(console):=name;
c.(:c24>18a.1:)-1       ;   if console testoutput
     jl. w3     d44.     ;   then type description;
z.    jl.     g35.      ;   goto next command;
 j2: <:s<0>:>            ; (prevent blocking communication with s)
e.

b.i24
w.g54:lo. w0  i0.       ; address:
     hs  w0  x1+c27      ;   abs addr(console):=true;
     am     c30-c39      ;
g56: al  w2  x1+c39      ; size:
     jl. w3     d16.     ;   next integer(integer);
     sz  w0       2.1    ;
     bs. w0       1      ;   integer(23):= 0;
     rs  w0  x2  +0      ;   word param(console):=integer;
c.(:c24>18a.1:)-1       ;   if console testoutput
     jl. w3     d44.     ;   then type description;
z.    jl.     g35.      ;   goto next command;
i0:1<1
e.
c.8000                   ; in rc8000:
b.i10
w.
                         ; mode :
; syntax mode <short integer>

g55: la. w0      i2.     ; abs protection=false
     rs  w0       4      ; w2=command mask
     jl. w3     d16.     ; next integer
     sn  w0       0      ; if mode=0 then
     lo. w2      i3.     ; abs protection=true
     rs  w2  x1+c26      ; 
     jl.        g35.     ; next command

z.
c.-4000                  ; only in rc4000

   g57:al  w2  x1+c26    ; key claim:
     la. w0      i2.     ;   abs protection(console):=false;
     jl.         i0.     ;   goto set param;
g59: al  w2  x1+c38      ; pk:
     lo. w0      i3.     ;   abs protection(console):=true;
i0:  hs  w0  x1+c27      ; set param:
     jl.         i1.     ;
z.

g60: am     c32-c33      ; buffer claim:
g61: am     c33-c34      ; area claim:
g62: al  w2  x1+c34      ; internal claim:
i1:  jl. w3     d16.     ;   next integer(integer);
     hs  w0  x2  +0      ;   byte param(console):=integer;
c.(:c24>18a.1:)-1       ;   if console testoutput
     jl. w3     d44.     ;   then type description;
z.    jl.     g35.      ;   goto next command;
i2:8.7773
i3:1<2
e.
c.-4000

b.i24                   ; pr:
w.g58:jl. w3  d45.      ;   next bitnumbers(bits, type);
     ls  w2     -16      ;   bits:=bits shift -16;
     lx. w2      i0.     ;   bits:=bits exor 8.377;
     lo. w2      i1.     ;   bits(16):=1;
     hs  w2  x1+c37      ;   pr(console):=bits(12:23);
c.(:c24>18a.1:)-1       ;   if console testoutput
     jl. w3     d44.     ;   then type description;
z.    jl.     g36.      ;   goto exam command;
i0:8.377
i1:1<7
e.
z.

; function mask:
g63: jl. w3     d45.     ;   next bitnumbers(bits, type);
     ls  w2     -12      ;
     hs  w2  x1+c35      ;   function mask(console):=bits(0:11);
c.(:c24>18a.1:)-1       ;   if console testoutput
     jl. w3     d44.     ;   then type description;
z.    jl.     g36.      ;   goto exam command;

g64:; create:
     jl. w3     d35.     ;
     rl. w2     e29.     ;   create child;
     rl  w0  x2+a17      ;
     wa  w0  x2+a182
     jl. w3     d36.     ;   modify child(first addr(child));
c.(:c24>18a.1:)-1       ;   if console testoutput
     jl. w3     d44.     ;   then type description;
z.    jl.     g35.      ;   goto next command;

; init:
g65: jl. w3     d35.     ;   create child;
     jl. w3     d37.     ;   load child;
     jl.        g35.     ;   goto next command;

; run:
g66: jl. w3     d35.     ;   create child;
     jl. w3     d37.     ;   load child;
     jl. w3     d38.     ;   start child;
     jl.        g35.     ;   goto next command;

; load:
g67: jl. w3     d34.     ;   check child;
     jl. w3     d37.     ;   load child;
     jl.        g35.     ;   goto next command;

; start:
g68: jl. w3     d34.     ;   check child;
     jl. w3     d38.     ;   start child;
     jl.        g35.     ;   goto next command;

; stop:
g69: jl. w3     d34.     ;   check child;
     jl. w3     d39.     ;   stop child;
     jl.        g35.     ;   goto next command;
c.(:c23>22a.1:)-1       ; if break option then
g70 = k                ; break:
     jl. w3  d34.      ; begin check child;
     jl. w3     d39.     ;   stop child;
     rl. w2     e29.     ;
     rl  w3  x2+a27      ;   addr:=interrupt addr(child);
     sn  w3       0      ;   if addr<>0 then
     jl.        g35.     ;   begin
     dl  w1  x2+a29      ;   word(addr):=save w0(child);
     ds  w1  x3  +2      ;   word(addr+2):=save w1(child);
     dl  w1  x2+a31      ;   word(addr+4):=save w2(child);
     ds  w1  x3  +6      ;   word(addr+6):=save w3(child);
     dl  w1  x2+a33      ;   word(addr+8):=save ex(child);
     ds  w1  x3 +10      ;   word(addr+10):=save ic(child);
     al  w1       8      ;   word(addr+12):=8;
     rs  w1  x3 +12      ;
     al  w0  x3+a180     ;   modify child(addr+a180);
     jl. w3     d36.     ;   start child;
     jl. w3     d38.     ;   end;
     jl.        g35.     ;   goto next command;
z.

; remove:
b. i24
w. g71:              ;
     jl. w3     d34.     ;   check child;
     al  w0       1      ;
     hs. w0     e81.     ;
     jl. w3     d39.     ;   stop child;
     jl. w3     d76.     ; adjust bs-claims
     jl. w3     d40.     ;   remove child;
     jl.        g35.     ;   goto next command;
i1:0   ;
e.
c.(:c23>21a.1:)-1       ; if include/exclude option then
g72 = k                ; include:
     am         2      ;
g73 = k                ; exclude:
b.i24                   ; begin
w.    rl. w3  i2.       ;
     rs. w3      i1.     ;
     jl. w3     d34.     ;   check child;
i0:  jl. w3      d2.     ; more:
     se  w0       2      ;   next param(type);
     jl.        g36.     ;   if type<>2
     rl. w1     e25.     ;   then goto exam command;
     al  w3  x1+c29      ;
     rl. w1     e19.     ;   include/exclude(name(console),
i1:  am           0      ;       integer,result);
     se  w0       0      ;   if result=0
     jl.        g16.     ;   then goto more
     jl.         i0.     ;   else goto end line;
i2:  jd     1<11+14      ;
     jd     1<11+12      ;
e.z.
c.(:c23>20a.1:)-1       ; if call option then
g74 = k                ; call:
b.i24                   ; begin
w.i0: jl. w3  d2.       ; more: next param(type);
     se  w0       2      ;   if type<>2 
     jl.        g36.     ;   then goto exam command;
     rl. w1     e19.     ;   device:=integer;
     jl. w3     d15.     ;   next name;
     al. w3     e20.     ;   create peripheral process(
     jd     1<11+54      ;   name,device,result);
     sn  w0       3      ;   if result=3
     jl.        g10.     ;
     sn  w0       4      ;   or result=4
     jl.        g16.     ;
     sn  w0       5      ;   or result=5
     jl.        g17.     ;   then goto end line
     jl.         i0.     ;   else goto more;
e.
z.
c.(:c23>19a.1:)-1       ; if list option then
b.i24 w.                ; begin
i7:  <: error <0>:>
i8:  <: stop  <0>:>
i9:  <: run   <0>:>
i10: <: wait  <0>:>
g75 = k                ; list:
   rl  w2  b6        ; :
i1:  sl  w2     (b7)     ; for i:=first internal step 1
     jl.        g35.     ; until last internal do
     rl  w1  x2          ;
     rl  w0  x1+a11      ; if name=0
     rl  w3  x1+a34      ; or
     al  w2  x2  +2      ; parent=0
     rs. w2     e78.     ;
     se  w0       0      ;
     sn  w3       0      ; else
     jl.         i1.     ; begin
     jl. w3     d19.     ; initwrite
     rl  w2  x2  -2      ;
     al  w1  x2+a11      ;
     jl. w3     d21.     ; writetext(processname)
     ac  w1  x1 -12      ;
     jl. w3     d70.     ; writespace(no af spaces)
     rl  w1  x2+a17      ;
     wa  w1  x2+a182
     al  w0       8      ;
     jl. w3     d71.     ; writeint(first core,8)
     rl  w1  x2+a18      ;
     ws  w1  x2+a17      ; 
     al  w0       8      ;
     jl. w3     d71.     ; writeint(coresize,8)
     zl  w1  x2+a25      ; 
     al  w0       3      ;
     jl. w3     d71.     ; writeint(key,4)
     zl  w1  x2+a12      ;
     al  w0       4      ;
     jl. w3     d71.     ; writeint(stopcount,4)
     bl  w0  x2+a13    ;   w0 := process state;
     al. w1     i7.    ;
     sz  w0     2.10000000;
     al. w1     i10.   ;
     sz  w0     2.00100000;
     al. w1     i8.    ;
     sz  w0     2.01000000;
     al. w1     i9.    ;
     jl. w3     d21.   ;   writetext(process state);
     rl  w1  x2+a34    ;
     al  w1  x1+a11      ;
     jl. w3     d21.     ; writetext(parent)
     al  w0      10      ;
     jl. w3     d20.     ; writechar(nl)
     jl. w3     d23.     ; typeline(buf)
     jl. w3     d42.     ; save work(buf)
     jl.         g47.    ; +2 error goto end line
     rl. w2     e78.     ;
     jl.         i1.     ;
e.
z.
c.(:c23>18a.1:)-1       ; if max option then
g76 = k                ; max:
b.i24                   ; begin
w.
     al. w1     g26.     ;
     jl. w3     d21.     ;   writetext(<:max:>);
     am       -2048      ;
     jl. w3     d29.+2048;   find max(size);
     jl. w3     d22.     ;   writeinteger(size);
     al  w0      32      ;
     jl. w3     d20.     ;   writechar(32);
     rl  w2      b1      ;
     bz  w1  x2+a19      ;
     ws. w1      e2.     ;   writeinteger(buf claim(s)
     jl. w3     d22.     ;                -own buf);
     al  w0      32      ;
     jl. w3     d20.     ;   writechar(32);
     bz  w1  x2+a20      ;
     ws. w1      e3.     ;   writeinteger(area claim(s)
     jl. w3     d22.     ;                -own area);
     al  w0      32      ;
     jl. w3     d20.     ;   writechar(32);
     bz  w1  x2+a21      ;
     jl. w3     d22.     ;   writeinteger(internal claim(s));
     al  w0      32      ;
     jl. w3     d20.     ;   writechar(32);
c.-4000
     al  w2       8      ;   keys:=8;
     jl. w3     d32.     ;   find keys(keys,pr,pk,
     jl.         i0.     ;             typekeys);
     am           0      ;
i0:  ac  w1  x2  -8      ; typekeys:
     jl. w3     d22.     ;   writeinteger(8-keys);
z.
     al  w0      10      ;
     jl. w3     d20.     ;   writechar(10);
     jl. w3     d23.     ;   typeline(buf);
     jl. w3     d42.     ;   save work(buf);
     jl.         g47.    ;+2:  error:  goto end line;
     jl.        g35.     ;   goto next command;
g35=k-2
e.
z.



c.(:c23>17a.1:)-1       ; if replace option then
g77 = k                ; replace:
b.i24                   ; begin
w.      am    d15-e0    ;
     jl. w3      e0.     ;   next name;
     al. w3     e20.     ;
     jd     1<11+52      ;   create area process(name,result);
     sn  w0       2      ;
     jl.        g11.     ;   if result=2
     se  w0       3      ;       or result=3
     sn  w0       4      ;       or result=4 then
     jl.        g12.     ;     goto end line;
     al. w1     e51.     ;
     rl  w3      b1      ; next buffer:
i0:  al  w2       0      ;   buf:=0;
     jd     1<11+24      ;   wait event(buf);
     jd     1<11+26      ;   get event(buf);
     ba. w0       1      ;   result:=result+1;
     sn  w0       1      ;   if result=1 then
     jd     1<11+22      ;     send answer(buf,answer,result);
     rl  w0  x3+a15      ;   next:=word(event q(proc));
     se  w0  x3+a15      ;   if next<>event q(proc) then
     jl.         i0.     ;     goto next buffer;
     al. w3     e20.     ;
     jd      1<11+8      ;   reserve process(name,result);
     sn  w0       1      ;   if result=1 then
     jl.         i2.     ;     goto give up;
     al. w1     e51.     ;
     jd     1<11+42      ;   lookup entry(name,tail,result);
     sn  w0       2      ;   if result=2 then
     jl.         i3.     ;     goto give up;
     bz. w0     e59.     ;
     se  w0       8      ;   if content<>8 then
     jl.         i4.     ;     goto give up;
     rl. w1     e60.     ;
     al  w1  x1+511      ;
     ls  w1      -9      ;   load size:=
     ls  w1       9      ;       (bytes(tail)+511)/512*512;
     jl. w3     d27.     ;   find size(start,size,give up);
     jl.         i6.     ;
     wa  w1       0      ;   last addr(area mess):=
     al  w1  x1  -2      ;     first addr+load size-2;
     ds. w1     e49.     ;   first addr(area mess):= first addr;
     rl. w1     e58.     ;   segment(area mess):=
     rs. w1     e50.     ;       segment(tail);
     bz. w1     e67.     ;
     wa  w1       0      ;
     rs. w1     i20.     ;   entry:= first addr+entry(tail);
     sh. w1    (e49.)    ;   if entry>last addr(area mess) then
     jl.          4      ;
     jl.         i5.     ;     goto give up;
     al. w1     e47.     ;
     al. w3     e20.     ;
     jd     1<11+16      ;   send mess(name,area mess,buf);
     al. w1     e51.     ;
     jd     1<11+18      ;   wait answer(buf,answer,result);
     rl. w1     e51.     ;
     lo  w1       0      ;   res:= status or result;
     jd     1<11+64      ;   remove process(name,result);
     se  w1       1      ;   if res <> 1 then
     jl.        g15.     ;     goto sorry;
     rl. w0     i22.     ;
     rs. w0     g30.     ;
     jl.         g1.     ;
i12: rl. w1     e24.     ; ok:
     rl  w2  x1+c50      ;   buf:= state(work);
     jd     1<11+18      ;   wait answer(buf,work,result);
     ld  w1     -100      ;   w0:= w1:= 0;
     rl. w2     e25.     ;   
     rl  w2  x2+c25      ;    w2:=process descr.(console)
     xl.          0      ;   ex:= 0;
     jl.       (i20.)    ;   goto entry;

i2:  am         g13-g11;
i3:  am         g11-g12;
i4:  am         g12-g14;
i5:
i6:  al. w2     g14.     ; give up:
     al. w3     e20.     ;
     jd     1<11+64      ;   remove process(name,result);
     jl      x2  +0      ;   goto end line;
i20:0               ; entry
i22: jl.    i12-g30      ; return to ok
e.
z.


;
; stepping stone
;
jl. d15., d15=k-2
     jl.        g2.      ;
g2=k-2
     jl.        d2.      ;
d2=k-2
     jl.        d19.     ;
d19=k-2
     jl.        d20.     ;
d20=k-2
     jl.        d21.     ;
d21=k-2 
     jl.        d23.     ;
d23=k-2
jl.        d16.
d16=k-2
jl. g27., g27=k-2 
jl.        d34.
d34=k-2
jl.        d42.
d42=k-2
jl. d46., d46=k-2
jl.        d61.
d61=k-2
     jl.        d77.     ;
d77=k-2
     jl.        d78.     ;
d78=k-2
     jl.        d70.     ;
d70=k-2
     jl.        d71.     ;
d71=k-2
     jl.        d84.     ;
d84=k-2     
     jl.        d85.     ;
d85=k-2
     jl.        g9.      ;
g9=k-2

b.i24                   ; dump:
w.g79:am      d15-e0
     jl. w3      e0.     ;   next name;
     jl. w3     d34.     ;   check child;
     dl  w1  x2+a43      ; get catbase of pr descr(child)
     al. w3      i1.     ; name=0
     jd     1<11+72      ; catbase(s)=catbase(child)
     se  w0       0      ; if not ok then
     jl.        g19.     ; goto end line: base illegal
     al. w3     e20.     ; name adr
     jd     1<11+52      ; create area process(name)
     al. w3     i1.    ;   (prevent remove process(name))
     sn  w0       2      ; if result=2 or
     jl.        i10.     ;
     sl  w0       2      ; result>2 then 
     jl.        i11.     ; goto give up
     al. w3     e20.   ;
     jd      1<11+8      ;   reserve process(name,result);
     se  w0       0      ;   if result<>0 then
     jl.         i12.     ;   goto give up;
     jl. w3     d39.     ;   stop child;
     rl. w2     e29.     ;
     al  w1     0        ;
     rs. w1   e46.+2     ; segmentno(mess)=0
     rl  w1  x2+a182     ; load base (child)
     dl  w3  x2+a18      ;
     wa  w2     2        ; add base
     wa  w3     2        ; 
     al  w3  x3  -2      ;   line addr:= first addr(child);
     ds. w3     e46.     ;   write addr:= top addr(child)-2;
     al. w3     e20.     ;
     al. w1     e44.     ;
     jd     1<11+16      ;   send mess(name,output,buf);
     al. w1     e51.     ;
     jd     1<11+18      ;   wait answer(buf,answer,result);
     rl. w1     e51.     ;
     sn  w0       1      ;   if result<>1
     se  w1       0      ;   or status(answer)<>0 then
     am     g15-g35      ; give up: area error
     am     g35-g11      ; goto next command
i10: am     g11-g12      ; give up: catalog error
i11: am     g12-g13      ;  - - - : area unknown
i12: al. w2     g13.     ;  - - - : area reserved
     jd     1<11+64      ; remove area process
     al. w3      i1.     ;
     dl. w1      i2.     ;
     jd     1<11+72      ; reset catalogbase(s)
     jl      x2+  0      ; exit , 

 i1: 0
     a107
 i2: a108-1
e.

b. i4
w.                     ;
; command syntax:  user <lower> <upper>
; command syntax:  login <lower> <upper>
; command syntax:  project <lower> <upper>
g86: am         c43-c42; user: update userbase;
g82: am         c42-c41; login: update loginbase;
g80: al  w2  x1+c41    ; project: update projectbase;
     jl. w3     d16.     ; next integer
     rs  w0  x2+0      ; lower := integer;
     jl. w3     d16.     ; next integer
     rs  w0  x2+2      ; upper := integer;
     jl.        g35.     ; next command
e.


b.i12                   ; bs:
w.                     ;
i2:  dl. w2     e21.     ;
     ds. w2      i4.     ;
     dl. w2     e23.     ;
     ds. w2      i5.     ;
     jl      x3          ;
g81: jl. w3     d34.     ; check child
     jl. w3     d15.     ;
     jl. w3      i2.     ;
     jl. w3     d16.     ; next integer
i0:  rs. w0     e52.     ; more:
     jl. w3     d16.     ; next integer
     rs. w0     e51.     ;
     dl. w0     e52.     ;
     al. w1     e51.+a110*4; index:= claim list end
i1:  ds  w0  x1  +2      ; repeat begin
     al  w1  x1  -4      ; claimlist(index):=claimchange
     se. w1     e51.     ; index:= index-4
     jl.         i1.     ; until index = claim list start
     al. w2      i3.     ;
     rl. w3     e25.     ;
     al  w3  x3+c29      ; w3 = process name(console)
     jd     1<11+78      ; set bs claims
     sn  w0       1      ; if result = 1
     jl.        g20.     ; then goto end line
     se  w0       0      ; if result <> 0
     jl.        g21.     ; then goto end line
     jl.        g35.     ; then goto exam command

; command syntax:  temp <docname> <segments> <entries>
g84:                   ; temp:
     am         c45-c47;   (update temp claims)

; command syntax:  perm <docname> <segments> <entries>
g85:                   ; perm:
     al  w3     c47    ;   (update perm claims)
     wa. w3     e25.   ;
     rs. w3     i6.    ;   save abs addr of claim;

     jl. w3     d15.     ;
     jl. w3      i2.     ;
     jl. w3     d16.     ; get segments
     rs. w0     e52.     ;
     jl. w3     d16.     ; get entries
     rs. w0     e51.     ;
     al. w2      i3.     ; name adr.
     jl. w3     d61.     ; get devno*8
     jl.        g16.     ; sorry goto end line
g16=k-2
     dl. w1     e52.     ;
     am.       (i6.)   ; update segments and entries;
     ds  w1  x2        ;
     jl.        g35.     ; next command
 i3:0
i4:0
0
i5:0
i6:  0                 ; abs addr of claim (in console descr)
e.
b.i40,j10
w.
c.(:c23>14a.1:)-1
g96 = k                ; get:
          am -1        ;
g89 = k                ; job:
     al  w0  0         ; set startflag
     rs. w0  i16.      ;
     al  w3  0         ;
     rs  w3  x1+c95+2  ; clear primin and primout
     rs  w3  x1+c96+2  ;
     jl. w3     d46.   ;   clear claimlist;
     jl. w3     d15.     ; get jobname
     al  w1       0      ; then get segment(0)
     rl. w2     e70.     ;
     jl. w3     d77.     ;
     rl. w1     e70.     ;
     rl  w3  x1+6        ; get no. of segments
     rs. w3     i14.     ;
     rl  w1  x1  +2      ;
     rs. w1     i12.     ;
     al  w2       0      ; find number of
     al  w3     512      ; entries in one
     wd  w3       2      ; susercatentry
     al  w3  x2-510    ;   w3 := last used in segment;
     rs. w3     e85.     ;
j8:  dl. w2     (i6.)    ;
     aa. w2     (i7.)    ; compute hashvalue
     wa  w2       2      ;
     al  w1       0      ;
     sh  w2      -1      ;
     ac  w2  x2          ;
     wd. w2     i14.
     rs. w1     i13.     ;
 j3: rl. w2     e71.     ;
     rs. w1     (i5.)    ;
     jl. w3     d77.     ; get segment
     jl. w3     d78.     ; find entry
     sl  w2       0      ; if entry address then
     jl.         j4.     ; copy information
     se  w2     -10      ; if entry ndon' excist then
     jl.        g22.     ; goto end line
     rl. w1     (i5.)    ; if entry not found on this segment
     al  w1  x1+1        ; then increase segment no.
     sn. w1    (i14.)    ; search cyclical through
     al  w1       0      ;
     se. w1    (i13.)    ;
     jl.         j3.
     jl.        g22.
 j4: rl  w1       4      ;
     wa. w1     i12.     ; last adr. +2 in userentry
     rs. w1     i15.
     rl. w1     (i3.)    ;
     rl  w3  x2+2        ; command mask(job) :
     rl  w0  x1+c26      ; if abs.protection, abs.addr or
     la. w0     i17.     ; 
     la. w3     i10.     ; all bs= true then
     lo  w0       6      ; 'or' these bits to
     rs  w0  x1+c26      ; command mask(console)
     al  w3  x1+c29      ; copy job to console buffer
     al  w2  x2+4        ; from process name
 j5: rl  w0  x2          ; to claim list
     rs  w0  x3          ;
     al  w2  x2+2        ;
     al  w3  x3+2        ;
     se  w3  x1+c95      ; (until i and o are defined in susercat) end
     jl.         j5.     ;
;
; create claim list(console)
;
     rs. w2      i1.     ;
     rl. w2     e70.     ;
     al  w2  x2+8        ; name adr. first dev(entry0)
     rs. w2      i2.     ;
     al  w2  x1+c44      ; start of claim list(console)
     rs. w2      i0.     ;
 j0: rl. w2      i2.     ;
     sl. w2    (i15.)    ; kan fjernes nar newcat er rettet !!!!!!!!!!!!!
     jl.         j2.     ; ---------""---------""-------""!!!!!!!!!!!
     jl. w3     d61.     ; get devno*8(next dev)
     jl.         j1.     ; not found: goto next dev.
     rl. w3      i1.     ; found: copy claim list:
     dl  w1  x3+2        ; begin
     wa. w2      i0.     ;
     ds  w1  x2+2        ;
     dl  w1  x3+6        ;
     ds  w1  x2+6        ; end
 j1: dl. w3      i2.     ; next device: get claim list adr.(userentry)
     al  w3  x3+12       ; and dev. name adr.(entry0)
     al  w2  x2+8        ;
     ds. w3      i2.     ;
     se. w2    (i15.)    ;
     jl.         j0.     ; then find next dev.
j2:                    ;
     rl. w1    (i3.)   ; restore console
     al  w2    -1      ;   areabuf := undef;
     rs. w2     (i4.)  ;
     sn. w2  (i16.)    ; if only load then
     jl.        g35.   ;   goto next command;
     jl.     g66.        ; else goto run
;
 i0: 0                   ; claim list start(console)
 i1: 0                   ; -2  claim list adr(userentry)
 i2: 0                   ; +0  dev. name adr.(entry0)
 i3: e25
 i4: e87
 i5: e79
 i6: e21
 i7: e23
i10: 8.77772006          ; prio+all bs, abs. protc., abs. addr.
i12: 0                   ; entry lenght
i13: 0                   ; name key
i14: 0                   ; catalog lenght
i15: 0                   ; last adr.+2(userentry)
i16: 0                   ; job indicator : 0=job command
i17: 8.1770
z.e.
b.i24
w.
g87: am         1<8    ; lock:  lock := true;
g88: al  w0     0      ; unlock:lock := false;
     rs. w0     (i0.)  ;
     jl.        g35.   ;   goto next command;
 i0: e80               ; lock indicator
e.



c. (:c23>15a.1:)-1



b. i30, j10           ;
w.                    ;

; command syntax:  modify <addr> <old contents> <new contents>

g91 = k                ; modify:
     jl. w3    (i22.)    ;   addr := next integer;
     sl  w0       0      ;   if illegal core-address then
     sl  w0    (116)     ;
     jl.        g15.     ;     goto end line;
     rl  w2       0      ;

     jl. w3    (i22.)    ;
     se  w0 (x2)         ;   if next integer <> core(addr) then
     jl.        g15.     ;     goto end line;

     jl. w3    (i22.)    ;
     rs  w0  x2          ;   core(addr) := next integer;

     jl.        g35.     ;   goto next command;

g90 = k                ; print:
     jl. w3    (i22.)    ; next integer
     am        -500      ;
     rs. w0     e37.+500 ;
     jl. w3    (i22.)    ; next integer
     am        -500      ;
     rs. w0     e38.+500 ;
     al. w3     i11.     ;
     jd      1<11+8      ; reserve printer
     se  w0       0      ; if result <> 0
     jl.       (i23.)    ; then goto end line
j0:  dl. w1     i12.     ; next:  init output area
     ds. w1      i1.     ;
     ds. w1      i3.     ;
     ds. w1      i7.     ;
     dl. w1     i13.     ;
     ds. w1      i4.     ;
     ds. w1      i5.     ;
     rl. w1     i14.     ;
     rs. w1      i2.     ;
     rs. w1      i6.     ;
     am        -500      ;
     rl. w1     e37.+500 ; print address(decimal)
     al  w0      10      ;
     al. w2      i1.     ;
     jl. w3      j3.     ;
     am        -500      ;
     rl. w2     e37.+500 ; print word(octal)
     rl  w1  x2          ;
     al  w0       8      ;
     al. w2      i3.     ;
     jl. w3      j3.     ;
     al  w1      -2      ;
     am        -500      ;
     la. w1     e37.+500 ;
     bz  w1  x1          ; print byte 1(decimal)
     al  w0      10      ;
     al. w2      i4.     ;
     jl. w3      j3.     ;
     al  w1      -2      ;
     am        -500      ;
     la. w1     e37.+500 ;
     bz  w1  x1  +1      ; print byte 2(decimal)
     al  w0      10      ;
     al. w2      i5.     ;
     jl. w3      j3.     ;
     am        -500      ;
     rl. w2     e37.+500 ;
     rl  w1  x2          ; print word(decimal)
     sl  w1       0      ; if word < 0
     jl.         j2.     ; then begin
     ac  w1  x1          ; change sign
     rl. w0     i15.     ;
     rs. w0      i6.     ; set minus
j2:  al  w0      10      ; end
     al. w2      i7.     ;
     jl. w3      j3.     ;
     am        -500      ;
     rl. w1     e37.+500 ;
     rl  w2  x1          ; print word(text)
     rl. w1     i26.     ;
j1:  ld  w2       8      ;
     sz  w1       8.340  ;
     sz  w1       8.200  ;
     la. w1     i25.     ;
     sz  w1       8.177  ;
     sz                  ;
     al  w1  x1 +32      ;
     sh  w1       0      ;
     jl.         j1.     ;
     rs. w1      i8.     ;
     al. w1     i10.     ;
     al. w3     i11.     ;
     jd     1<11+16      ; send message
     jl. w3     d42.     ;   save work(buf);
     jl.         j6.     ;+2:  error:  goto end print;
     am        -500      ;
     rl. w1     e37.+500 ; first addr
     al  w1  x1  +2      ; +2
     am        -500      ;
     rs. w1     e37.+500 ; =: first addr
     am        -500      ;
     rl. w2     e38.+500 ;
     sh  w1  x2          ; if first addr<=last addr
     jl.         j0.     ; then goto next
j6:; end print:
     al. w3     i11.     ;
     jd     1<11+10      ; release printer
     jl.       (i24.)    ; goto next command
j3:  ds. w0     i19.     ; save return and radix
j4:  al  w3       0      ; next word: s:= 0
j5:  al  w0       0      ; next char:
     wd. w1     i19.     ;
     wa. w0     i16.     ;
     as  w0  x3          ; remainder shift s
     wa  w0  x2          ; + word(i)
     rs  w0  x2          ; =: word(i)
     sn  w1       0      ; if quotient = 0
     jl.       (i18.)    ; then return
     al  w3  x3  +8      ; s:= s+8
     se  w3      24      ; if s<>24
     jl.         j5.     ; then goto next char
     al  w2  x2  -2      ; i:=i-2
     jl.         j4.     ; goto next word
i0:0                ;
i1:0                ; addr
<:   :>          ;
i6:0                ;
0                ;
i7:0                ; decimal
0                ;
i4:0                ; byte 1
0                ; 
i5:0                ; byte 2
<:   :>          ;
i2:0                ;
0                ;
i3:0                ; octal
<:   :>          ; 
i8:0                ; text
i9:<:<10>:>         ;
i10:5<12             ; message
i0               ;
i9               ;
0               ;
i11:<:printer:>,0,0  ; name
<:      :>           , i12=k-2
<:      :>           , i13=k-2
<:   :>              , i14=k-2
<:-  :>              , i15=k-2
<:<0><0><16>:>       , i16=k-2
i18:0                ; link
i19:0                ; radix
i22:d16              ; next integer
i23:g1               ; error
i24:g35              ; next command
i25:8.7777 7400      ;
i26:128<16+128<8+128 ;
z.
e.


b. i24
w. g93:             ; prio:
     jl. w3     d16.     ; read priority
     sz. w0    (i1.)   ;   if prio < 0 or prio >= 4096 then
     jl.        g27.     ; goto end line: illegal priority
     hs  w0  x1+c26      ;
     jl.        g35.     ; else goto next command
 i1:  -1<12
e.


b.i10
w.g99:              ; jobremove
       am      -2046      ;
     jl.  w3     d34.+2046   ; check child
     al  w2  -1      ;
     rs  w2  x3+c22   ; coretableelement:=not job
     jl.     g71.    ; goto remove
e.


b.i3
w.g100:             ; base
     jl. w3     d16.     ; next integer
     rs. w0      i3.     ;
     jl. w3     d16.     ; next integer
     rl. w3      i3.     ;
     ds  w0  x1+c42+2    ; set bases
     ds  w0  x1+c41+2    ;
     ds  w0  x1+c43+2    ;
     jl.        g35.     ;
i3:0
e.
; adjust rest claims in usercat.
; comment: change the perm rest claims in susercat
; to the value given by the internal process descr. for key=3.
; temp claims are unchanged.
;
;     call         return
; w0               destroyed
; w1               destroyed
; w2               destroyed
; w3  link         destroyed
;
 b.i20, j10
 w.

d76: rs. w3     i10.     ; store return in save area
     am       -2046      ;
     rl. w3  e30.+2046   ;
     rl  w1  x3+c22      ; if segmentno= -1 then
     sh  w1      -1      ; return: no susercatjob
     jl.       (i10.)    ;
 c.(:c23>14 a.1 :)-1
     rl. w2      i2.     ; 
     jl. w3     d77.     ; get segment
     am       -2046       
     rl. w1  e30.+2046   ;
     rl  w1  x1+c22      ;
     am       -2046      ;
     rs. w1  e46.+2+2046 ; store segmentno in output mess
     am       -2046      ;
     rl. w1  e29.+2046   ; get procname(child)
     al  w2  x1+a11      ; and store in name area
     am       -2046      ;
     al. w3  e20.+2046   ;
     rs. w3     i13.     ; :=addr(curr. process);
     dl  w1  x2+2        ;
     ds  w1  x3+2        ;
     dl  w1  x2+6        ;
     ds  w1  x3+6        ;
     jd     1<11+4       ; get pr descr.(proc name)
     rs. w0      i0.     ;
     se  w0       0      ; if error then
     jl.         j0.     ;
     jl.        g9.      ; goto end line: process unknown
 j0: jl. w3     d78.     ; find entry
     sh  w2      -1      ; if entry not found then
     jl.         j4.     ; goto end line: catalog error
     al  w2  x2+48       ;
     rs. w2      i3.     ; perm claim adr(userentry)
     rl. w2      i1.     ;
     al  w2  x2+8        ;
     rs. w2      i4.     ;
 j1: rl. w2      i4.     ; adjust rest claims
     jl. w3     d61.     ; for i=0 step 1 
     jl.         j2.     ; until last dev.(entry0)
     rl. w2     i4.      ; w2:=addr(curr device);
     rl. w3     i13.     ; w3:= addr(curr process);
     jl. w1     d85.     ; lookup bs claims(device,process);
     rl. w2     i3.      ; addr(perm claim.curr process);
     dl  w0  x1+14       ; w0:=segments; w3:=entries;
     ds  w0  x2+2        ;
 j2: dl. w2     i4.      ; next device:
     al  w2  x2+12       ; 
     al  w1  x1+8        ;
     ds. w2      i4.     ;
     rl. w1      i1.     ;
     rl  w1  x1+4
     am.       ( i1.)    ; if  dev.name.adr. <
     sh  w2  x1          ; last used of entry0 then
     jl.         j1.     ; goto next , else
     rl. w2      i2.     ; store segment:
     al  w3  x2+510      ; create output mess.
     am       -2046      ; first adr. h20
     ds. w3  e46.+2046   ; last adr. h20+510
     rl. w3      i5.     ; segment no:stored above
     jd     1<11+52     ; create area.susercat
     jd      1<11+8      ; reserve(susercat)
     sn  w0       0      ;
     jl.         j5.     ;
     am        -2046     ; if error then
     jl.     g15.+2046   ; write: area error
 j5: am       -2046      ;
     al. w1  e44.+2046   ;
     jd     1<11+16      ; send mess.
     rl. w1     i11.     ;
     jd      1<11+18     ; wait answer
     lo. w0    (i11.)    ; 'or' status and result
     sn  w0       1      ; if <> 1 then goto error
     jl.         j6.     ;
 j4: am       -2046      ; error
     al. w1  g11.+2046   ; write catalog error
     rs. w1     i10.     ;
 j6: rl. w3      i5.     ;
     jd     1<11+64      ; remove area susercat
     am        -2048    ;
     rs. w3     e87.+2048;   areabuf := undef;
     jl.       (i10.)    ; return
;
 i0: 0                   ; pr.descr.adr(procname)
 i1: h19                 ; entry0 adr.
 i2: h20                 ; user segment adr.
z.
      am  -2046
     jl.  g18.+2046

 i3: 0                   ; -2, perm claim list adr(userentry)
 i4: 0                   ; +0, dev.name adr(entry0)
 i5: c69                 ; susercat name adr.
 i6: 0                   ; segmentno in susercat
i10: 0                 ; return adr.
i11: e51               ; answer status adr.
i12: 0                   ; slice length;
i13: 0                   ; addr of current process;
e.
; s command lookup bs claims
; name: lookbs
; call: lookbs <process> !
;      lookbs <process><sp><device><sp>...<sp><device>
; print the bs claims for the given process and device,
; in the first case it is printed for all devices 
b.  i10,j11
w.
g101:jl. w3     d2.      ; next param
     se  w0     1        ; if type<>name then
     jl.        g2.      ; goto end line;
     rs. w0     i0.      ;  i0:=1;
     rl. w3     i1.      ; w3:=addr(name);
     al. w2     i2.      ;
     dl  w1  x3+2        ;
     ds  w1  x2+2        ;
     dl  w1  x3+6        ;
     ds  w1  x2+6        ; move name;
     rl  w2     92       ; print all devices:
     jl.        j3.      ; w2:=addr(first in device list);
j1:  rl. w3     i0.      ;
     se  w3     1        ; if not first time then
     jl.        j4.      ;  goto next device else
     rs. w1     i0.      ; i1:=addr(bs claim store);
     al. w1     i2.      ; w1:=addr(process);
     jl. w3     d19.     ; init write;
     jl. w3     d21.     ; write(process name);
     jl. w3     j9.      ; print space;
     al. w1     i4.      ;
     jl. w3     d21.     ; write(head);
     al  w0     10       ;
     jl. w3     d20.     ; print new line;
     jl. w3     d23.     ; outline;
     jl. w3     d42.     ; save(work.buff);
     jl.        g2.      ; return-2 else
j4:  rl. w1     i1.      ; w1:=addr(device);
     jl. w3     d19.     ; init write;
     jl. w3     d21.     ; write(device name);
     jl. w3     j9.      ; print fill;
     rl. w2     i0.      ; w2:=addr(bs claim store);
j2:  rl  w1  x2+2        ; w1:=next segment-claim;
     al  w0     6        ;
     jl. w3     d71.     ; write(segment-claim);
     al  w0     44       ;
     jl. w3     d20.     ; write(<:,:>);
     al  w0   4          ;
     rl  w1  x2          ; w1:=next entry claim;
     jl. w3     d71.     ; write(entry claim);
     al  w2  x2+4        ; w2:=addr(next claim);
     am.        (i0.)    ;  
     sh  w2     a110*4+2 ; if claim addr<= last claim then
     jl.        j2.      ; goto j2;
     al  w0     10       ;
     jl. w3     d20.     ; print new line;
     jl. w3     d23.     ; outline;
     jl. w3     d42.     ; save(work.buff);
     jl.        g2.      ; return-2 else
     rl. w2     i3.      ; w2:=param type or next addr in device list;
j5:  al  w2  x2+2        ; next device;
     sl  w2     101      ; if addr in device list then
     jl.        j6.      ; goto test next device;
j3:  jl. w3     d2.      ; else next param;
     rs. w0     i3.      ; set param type;
     sn  w0     1        ; if type=name then
     jl.        j0.      ; goto next device else
     se  w0     0        ; else if type<>empty then
     jl.        g2.      ; goto end line else
     sh  w2     100      ; if param list then
     jl.        g35.     ; goto next command else
j6:  rs. w2     i3.      ; :=next addr in device list
     sn  w2     (96)     ; if w2=last in name table then
     jl.        g35.     ; goto next command else
     rl  w3  x2          ; w3:=addr(next device table head);
     rl  w0  x3-18       ; w0:=first word in name;
     sn  w0     0        ; if device=idle then
     jl.        j5.      ; goto next device
     rl. w2     i1.      ; w2:=addr(name store);
     dl  w1  x3-16       ;
     ds  w1  x2+2        ;
     dl  w1  x3-12       ;
     ds  w1  x2+6        ; move device name;
j0:  al. w3     i2.      ; w3:=addr(process);
     rl. w2     i1.      ; w2:=addr(device name);
     jl. w1     d85.     ; lookupbsclaims(device,process);
     sn  w0     0        ; if result=ok then
     jl.        j1.      ; goto print else
     sn  w0     2        ; if result=2 then
     jl.        g16.     ; goto write(device not exist);
     sn  w0     3        ; if result=3 then
     jl.        g9.      ; goto write(process not exist);
     jl.        g2.      ; else goto end line;
j9:  al  w1  x1-11       ; procedure write 12-w1 space
     ac  w1  x1          ;
     jl.        d70.     ; return via d70
i0:  0                   ; addr(bs claim store);
i1:  e20                 ; addr(name parameter);
i2:  0,r.4               ; process name;
i3:  0                   ; param type or next addr in device list
i4:  <: temp          perm-key1     login         user<0>:>; head;
e.
e86: 0,r.(:a110+1:)*2    ; bs claim store;


; character table:
; contains an entry of 3 bits defining the type of each
; character in the iso 7 bit character set.

w.h0: 8.7777 7777       ; nul soh stx etx eot enq ack bel
8.7757 7777       ; bs  ht  nl  vt  ff  cr  so  si
8.7777 7777       ; dle dc1 dc2 dc3 dc4 nak syn etb
8.7667 7777       ; can em  sub esc fs  gs  rs  us
8.3666 6666       ; sp
8.6666 4244       ; (   )   *   +   ,   -   .   /
8.1111 1111       ; 0   1   2   3   4   5   6   7
8.1125 6466       ; 8   9   :   ;   <   =   >
8.6666 6666       ;     a   b   c   d   e   f   g
8.6666 6666       ; h   i   j   k   l   m   n   o
8.6666 6666       ; p   q   r   s   t   u   v   w
8.6666 6666       ; x   y   z   æ   ø           _
8.6000 0000       ;     a   b   c   d   e   f   g
8.0000 0000       ; h   i   j   k   l   m   n   o
8.0000 0000       ; p   q   r   s   t   u   v   w
8.0000 0067       ; x   y   z   æ   ø          del

; command table:
; each entry consists of two words defining the name of the
; command, a eigth bits defining a bit to test in the console mask,
; and a sixteen bits defining the address of the command action
; relative to g45.

w.h2 = k-6        ; base of command:
<:all<0>:>  , 1<17+g83-g45
<:addr:>    , 1<17+g54-g45
<:area:>    , 1<17+g61-g45
<:base:>,1<18+g100-g45
<:break:>   , 1<20+g70-g45
<:lookbs:>  ,1<17+g101-g45
<:bs<0><0>:>, 1<17+g81-g45
<:buf<0>:>  , 1<17+g60-g45
<:call:>    , 1<17+g74-g45
<:create:>  , 1<16+g64-g45
<:date:>    , 1<21+1<14+g49-g45
<:dump:>    , 1<20+g79-g45
<:exclud:>  , 1<19+g73-g45
<:i:>,0     , 1<20+g94-g45
<:functi:>  , 1<17+g63-g45
<:includ:>  , 1<19+g72-g45
<:init:>    , 1<16+g65-g45
<:intern:>  , 1<17+g62-g45
<:job<0>:>,1<20+g89-g45
<:get<0>:>  , 1<20+g96-g45
<:list:>    , 1<20+1<14+g75-g45
<:load:>    , 1<20+g67-g45
<:lock:>, 1<15+g87-g45
<:login:>, 1<18+g82-g45
<:max<0>:>  , 1<20+1<14+g76-g45
<:modify:>  , 1<21+1<14+g91-g45
<:new<0>:>  , 1<16+g51-g45
<:jobrem:>, 1<15+g99-g45
<:o:>,0     , 1<20+g95-g45
<:perm:>,1<17+g85-g45
<:prio:>,1<18+g93-g45
<:proc:>    , 1<20+g52-g45
<:prog:>    , 1<20+g53-g45
<:projec:>,1<18+g80-g45
<:read:>    , 1<20+1<14+g57-g45
<:remove:>  , 1<20+g71-g45
c.(:c23>17a.1:)-1
<:replac:>  , 1<15+g77-g45
z.
<:run<0>:>  , 1<16+g66-g45
<:size:>    , 1<18+g56-g45
<:start:>   , 1<20+g68-g45
<:stop:>    , 1<20+g69-g45
<:temp:>,1<17+g84-g45
<:unlock:>,1<15+g88-g45
<:unstac:>  , 1<20+1<14+g58-g45
<:user:>,1<18+g86-g45
<:mode:>     , 1<21+g55-g45
c.-4000
<:key<0>:>        , 1<17+g57-g45
<:pk<0><0>:>   , 1<18+g59-g45
<:pr<0><0>:>   , 1<18+g58-g45
z.
<:print:>   , 1<21+1<14+g90-g45
h3:h13   ; continue command list

; define b-names for transferring variables to mons2-text

b110 = g45   ; command base
b112 = d2    ; call next param
b113 = d15   ; call next name
b114 = d16   ; call next integer
b115 = g2    ; goto syntax error
b116 = g35   ; goto next command
b117 = g36   ; goto exam command
b118 = e19   ; integer just read
b119 = e20   ; name just read
b120 = e8    ; pointer to: last of init code
b121 = d19   ; call init write
b122 = d20   ; call write char
b123 = d21   ; call write text
b124 = d23   ; call type line
b125 = d42   ; call save work
b126 = g47   ; goto input aborted
b129 = g11   ; goto catalog error
b130 = d79   ; call stack input

; console table:

h4:0, r.c81*c1>1     ; lay out standard console descriptions
h22=k-c1               ; last description

; initialize standard console descriptions.
;  c20, c21 queue element  (queued up on the queue head)
;  c27      command mask           (standard mask)
b.i4,j2 w.

i0:0                 ; saved link
h4+c1             ; next element
i1:h4-c1             ; last element
i2:e35               ; queue head

j0:  rs. w3      i0.     ; start:
     al. w1      i0.     ;
     rs  w1  x2  +0      ;   first free:=start of init code;
     al  w0     c82      ;
     dl. w2      i1.     ;
      am      -2046     ;
           al. w3      h4.+2046     ;
j1:  rs  w0  x3+c27      ;   for console desc:=first stop 1 until last do
     ds  w2  x3+c21      ;     mask(console desc):=standard mask;
     al  w1  x1 +c1      ;     next,last queue element:=next, last console desc;
     al  w2  x2 +c1      ;
     al  w3  x3 +c1      ;
     sh. w3     h22.     ;
     jl.         j1.     ;
     rl. w2      i2.     ;   insert queue head in first and last console des;
     am     -2046
     rs. w2      h4.+c21+2046 ;
     rs. w2     h22.+c20 ;
     al  w0       0      ;
     al  w2       0      ;
     jl.        (i0.)    ;   return to slang;

     jl.         j0.     ;   goto start;
e.j.

h21=k                  ; start of special console descriptions

t.m.                s console table included

h. h5=k-c1   ; last console
 
; device exception table (devices not automatically included with users )
; the numbers in order of increasing value:
h6:                 ; start(table)
t.m.                s device exclusion table included
    2047            ; last(table)
w.
w.

; work table:

h. h8:       ; first work:
0,r.c2*c3
h9=k-c2   ; last work:
c.(:c23>14a.1:)-1
h. h19:  -1,r.c89
h20:-1,r.512
z.

; core table:
; contains an entry for each storage area allocated to a child.
; an entry defines the address of a child description within the
; monitor. the entries are arranged in the same order as the
; storage areas from low towards high addresses. the table is
; terminated by a zero.

w.
h10 = k - c11 ; base of core table:
-1, r.(:a3-2:)*c11>1 ; lay out core table
h11=k                  ; top of coretable

m.                first free addr

; initialize core table.
; all entries in the core table is initialised to this values-
;   k, k-2, -1, r.5
b.i1,j1 w.
i0:h10+c11           ; absolute addr of core table
i1:h10.+c11          ; relative addr of core table

j0:  al. w1      i0.     ; start:
     rs  w1  x2  +0      ;   first free:=start of init code;
     rl. w1      i0.     ;
     al. w2      i1.     ;
     wa. w2      i1.     ;
j1:  rs  w1  x2  +0      ;   for entry:=first stop 1 until last do
     rs  w1  x2  +2      ;     word(entry+0,+2):=k, k-2;
     al  w1  x1+c11      ;
     al  w2  x2+c11      ;
     se. w2      h11.    ;
     jl.         j1.     ;
     al  w0       0      ;
     al  w2       0      ;   status:=ok;
     jl      x3          ;   return to slang;

     jl.         j0.     ;   goto start;
e.j.


h12:
h13 = - (:h12 + 2:)  ;  command table continues in second word of next text

b. i24 w.

; table of preoccupied claims:
; mess buf      area          internal
i0=1          , i1=a112+1   , i2=1          ; proc func
i3=1+a117     , i4=0        , i5=1          ; std driver
i6=a5-i0-i3   , i7=a1-i1-i4 , i8=a3-i2-i5   ; s

i10: rs. w3     i12.     ;    save return to autoloader;

; initialize work table
b. j1 w.
     al. w3     h8.    ;
j0:                    ; rep:
     al  w1  x3+c73    ;   for all work table entries do
     rs  w1  x3+c58    ;     stack pointer := stack base;
     al  w3  x3+c2     ;
     sh. w3     h9.    ;
     jl.        j0.    ;
e.                     ;

; initialize special console descriptions.
b.j3 w.
     al. w3     (j2.)    ;
     jl.         j1.     ;
j0:  rl  w1  x3+c25      ;   for console desc:=first step 1 until last do
     ls  w1       1      ;     proc desc addr(console):=
     wa  w1      b4      ;       word(base name table(dev)+2*devno);
     rl  w1  x1          ;
     rs  w1  x3+c25      ;
     al  w3  x3 +c1      ;
j1:  sh. w3      (j3.)    ;
     jl.         j0.     ;
     jl.        i9.

j2: h21
j3: h5
e.

; process description for process functions:
;
; rel address contents

 i9: rl  w1     (b6)     ;    proc := first internal;
     jl. w2     i18.     ;    init description;

a48    , a107              ; interval low
a49    , a108              ;    -     high
a11    , 0                 ; name 0 : zero
a11+2  , <:pro:>           ; name 2-6: <:procfunc>
a11+4  , <:cfu:>           ;
a11+6  , <:nc:>            ;
a17    , b60-b60+8         ; first address
a18    , b61               ; top address
a301   , 0                 ; priority
a26    , a89               ; interrupt mask
a27    , b62               ; user exception address
a170   , 0                 ; user escape address
a32    , 0                 ; status = not monitor mode
a33    , b63               ; ic = waiting point
a182   , 0                 ; base = no relocation
a183   , 8                 ; lower write limit = first core
;*** a184   , core size         ; top write limit: special
a185   , 6<12+b54          ; interrupt levels
a42    , a107              ; catalog base low
a43    , a108              ;    -     -   high
a44-2  , a107              ; max interval low
a44    , a108              ;  -     -     high
a45-2  , a107              ; std    -     low
a45    , a108              ;  -     -     high
a302   , 0                 ; save area address

a10    , 0;(end of words)  ; kind = 0

a12    , 0                 ; stop count
a13    , a102              ; state = waiting for message
a19    , i0                ; buf claim
a20    , i1                ; area claim
a22    , 8.7777            ; function mask

a10    , 0;(end of bytes)  ; (kind = 0)

     rs  w0  x1+a184     ;    top write limit(proc func) := core size;

; process description for initial operating system, s

     al  w1  x1 +a4      ;    proc := second internal;
     jl. w2     i18.     ;    init description;

a48    , a107              ; interval low
a49    , a108              ;    -     high
a11    , <:s:>             ; name = <:s:>
a11+2  , 0                 ;
a11+4  , 0                 ;
a11+6  , 0                 ;
a17    , c0                ; first address
;*** a18    , core size         ; top address
a301   , 0                 ; priority
a26    , a89               ; interrupt mask
a27    , d0                ; user exception address
a170   , 0                 ; user escape address
;*** a171   , core size         ; initial cpa
a172   , 0                 ;    -    base
a173   , 8                 ;    -    lower write limit
;*** a174   , core size         ;    -    upper   -     -
a175   , b54<12+b54       ;    -    interrupt levels
a32    , 0                 ; status = not monitor mode
a33    , h12               ; ic = start init
a34    , 0                 ; parent = undef
;*** a181   , core size         ; current cpa
a182   , 0                 ;    -    base
a183   , 8                 ;    -    lower write limit
;*** a184   , core size         ;    -    upper   -     -
a185   , b54<12+b54        ;    -    interrupt levels
a42    , a107              ; catalog base low
a43    , a108-1            ;    -     -   high
a44-2  , a107              ; max interval low
a44    , a108-1            ;  -      -    high
a45-2  , a107              ; std interval low
a45    , a108-1            ;  -      -    high
a302   , 0                 ; save area address

a10    , 0;(end of words)  ; kind = 0

a12    , 0                 ; stopcount
a13    , a95               ; state = running
a19    , i6                ; buf claim
a20    , i7                ; area claim
a21    , i8-1              ; internal claim
a24    , 1<7               ; (protection register, for compatibility reasons)
a25    , 0                 ; (protection key, for compatibility reasons)
a22    , 8.7777            ; function mask

a10    , 0;(end of bytes)  ; (kind = 0)

     rs. w0    (4)     ;   top core :=
     jl.        4      ;
         e17           ;
     rs  w0  x1+a18      ;    top address(s) :=
     rs  w0  x1+a171     ;    initial cpa(s) :=
     rs  w0  x1+a174     ;    initial upper write limit(s) :=
     rs  w0  x1+a181     ;    current cpa(s) :=
     rs  w0  x1+a184     ;    current upper write limit(s) := core size;

; process description for std driver

     al  w1  x1 +a4      ;    proc := next internal;
     jl. w2     i18.     ;    init description;

a48    , a107              ; interval low
a49    , a108-1            ;    -     high
a11    , <:dri:>           ; name = <:driver proc:>
a11+2  , <:ver:>           ; 
a11+4  , <:pro:>           ;
a11+6  , <:c:>             ;
a17    , 8                 ; first address
a18    , b60               ; top address
a301   , -1                ; priority
a26    , a89               ; interrupt mask
a27    , b87               ; user exception address
a170   , 0                 ; user escape address
a171   , b60               ; initial cpa
a172   , 0                 ;    -    base
a173   , 8                 ;    -    lower write limit
a174   , b60               ;    -    upper   -     -
a175   , 6<12+b54          ;   -    interrupt levels
a32    , 0                 ; status = not monitor mode
a33    , b85               ; ic = central waiting point
a34    , 0                 ; parent = undef
a181   , b60               ; current cpa
a182   , 0                 ;    -    base
a183   , 8                 ;    -    lower write limit
a184   , b60               ;    -    upper   -     -
a185   , 6<12+b54          ;    -    interrupt levels
a42    , a107              ; catalog base low
a43    , a108-1            ;    -     -   high
a44-2  , a107              ; max interval low
a44    , a108-1            ;  -     -     high
a45-2  , a107              ; std interval low
a45    , a108-1            ;  -     -     high
a302   , b86               ; save area address

a10    , 0 ;(end of words) ; kind = 0

a12    , 0                 ; stopcount
a13    , a95               ; state = running
a19    , i3                ; buf claim
a20    , i4                ; area claim
a21    , i5-1              ; internal claim
a24    , 1<7               ; (protection register)
a25    , 0                 ; (protection key)
a22    , 8.7777            ; function mask

a10    , 0 ;(end of bytes) ; (kind = 0)
\f


     al  w2  x1+a16      ;
     rl  w1      b2      ;    link(timer q, internal);
     jl  w3     b36      ;
     al  w2  x2 -a4      ;    link(timer q, previous internal);
     jl  w3     b36      ;


     jl. w3     i14.     ;   take control
b3               ;     (first name table entry,
b6               ;      first internal,
b29+2*a4         ;      driver proc);

     jl. w3     i14.     ;   take control
b76              ;     (first secondary interrupt,
k                ;      irrellevant,
b29+2*a4         ;      driver proc);

     al. w2     i10.     ;
     jl.       (i12.)    ;   autoloader(first core);
i13:e4                ;

; take control
; comment: searches through the specified part of name table and initializes driver
;          proc address.

i14: rl  w1 (x3)         ;   entry := param 1;

i15: am     (x3  +2)     ; next:
     sn  w1      (0)     ;   if entry = top entry (i.e. param 2)
     jl      x3  +6      ;      then return;

     rl  w2  x1  +0      ;   proc := nametable(entry);
     sn  w2       0      ;   if end of table then
     jl      x3  +6      ;      then return;

     rl  w0  x3  +4      ;   if driverproc(proc) = 0 then
     rx  w0  x2+a250     ;      driverproc(proc) := param 3;
     se  w0       0      ;
     rs  w0  x2+a250     ;

     al  w1  x1  +2      ;   entry := entry + 2;
     jl.        i15.     ;   goto next;

; procedure init description
; call: w1 = process description address, w2 = init table
; exit: w0 = core size, w1 = unchanged
i18: dl  w0  x2  +2      ; move words:
     al  w2  x2  +4      ;    move contents to outpointed
     am      x1          ;      relatives in process description
     rs  w0  x3          ;
     se  w3     a10      ;      until kind is moved;
     jl.        i18.     ;

i19: dl  w0  x2  +2      ; move bytes:
     al  w2  x2  +4      ;    move contents to outpointed
     am      x1          ;      relatives in process description
     hs  w0  x3          ;
     se  w3     a10      ;      until kind is moved;
     jl.        i19.     ;
     rl  w0     b12      ;
     jl      x2          ;


i12:0                 ; after loading:
     jl.        i10.     ;   goto initialize segment;
c70= k-b127 + 2
k=i10                  ;
e.                      ;
i.

e.     ; end of operating system s
▶EOF◀