|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 70656 (0x11400)
Types: TextFile
Names: »mons2«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦87223b8a0⟧ »kkrcmonfil«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦87223b8a0⟧ »kkrcmonfil«
└─⟦this⟧
\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;
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. 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
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
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 ;
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 ;
jl. j0. ;
am -2046 ; if error then
jl. g9.+2046 ; 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 x3-a88-2 ; begin
wa. w2 i0. ; find chaintable(dev.)
al w2 x2+6 ; if not found goto next device
zl w0 x2 ; perm entries(suserentry)
rl. w1 i3. ; = entry claim(pr.descr.) , key=3
rs w0 x1 ;
zl w0 x2+1 ; perm segments
wm w0 x3-a88+26 ; = slicelenght(dev)*slice claim(pr.descr.)
rs w0 x1+2 ; end
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.
e.
; 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
<: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◀