|
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: 69120 (0x10e00)
Types: TextFile
Names: »mons1«
└─⟦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. mons1 - operating system s, part 1
b.i30 w.
i0=81 05 20, i1=12 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.
; rc date
; segment 8: operating system s
s. k=k, h50,g110,f29,e90,d90,c100,j5
w.b127=k, c70, k = k-2
; segment structure:
; definitions (c names)
; utility procedures (d names)
; variables (e names)
; command actions (g names)
; tables (h names)
;
; (i and j names are used locally)
; size options:
c0=k ; first addr of s
; c1=def below; size of console description
; c2=def below; size of work area
c3=4 ; no of own work areas
c16= 2 ; stack depth ( of nested 'reads' )
c4=c3+1 ; no of own buffers
c5=2 ; no of own area processes
c7=7 ; - buf
c8=6 ; - area
c9=0 ; - internal
c10=8.7440 ; - function
;c11=def below; size of core table entry
c12=12800 ; standard size
c13=20 ; - entries,perm,work device
c14=800 ; - segments,perm,work device
c81=a117/2 ; number of console desriptions (arbitrary choosen value)
c82=8.0760 ; standard mask
c89=8+12*a112 ; standard length of susercatentry
c100=1 ; number of privileged conseles
c15=k, <:disc:>,0,0 ; standard work device name
; definition of chain head. chain heads may be
; placed any where in the elements, but the location
; must be the same in all sorts of chains
;c69 ; susercatname
c20=0 ; next chain element
c21=c20+2 ; last chain element
c23= 8.77740000 ; systemoptions: all commands,
; terminals unblocked after start up.
t.m. s size options included
c4=c3+1; no of own buffers
c5=2 ; no of own area processes
; systemoptions:
; systemoptions determine whether code is included for certain
; commands. they are defined by bits in the identifier c23
; as follows:
;
; break: c23=c23 o. 1<22
; include/exclude: c23=c23 o. 1<21
; call: c23=c23 o. 1<20
; list: c23=c23 o. 1<19
; max: c23=c23 o. 1<18
; replace: c23=c23 o. 1<17
; all: c23=c23 o. 1<16
; print: c23=c23 o. 1<15
; job: c23=c23o.1<14
; terminals blocked after start up c23=c23 o. 1<13
; testoptions:
; testoptions are used during debugging of the system. they
; are defined by bits in the identifier c24 as follows:
;
; internal interrupt: c24=c24 o. 1<23
; character testoutput: c24=c24 o. 1<22
; parameter testoutput: c24=c24 o. 1<21
; event testoutput: c24=c24 o. 1<20
; work testoutput: c24=c24 o. 1<19
; console testoutput: c24=c24 o. 1<18
c24 = a93
; definition of core table entry format:
;c20=def above; next entry
;c21=def above; last entry
c17=c21+2 ; child
c18=c17+2 ; child console
c22=c18+2 ; segment no in susercat or -1
c19=c22+2 ; kind , name of alternative primary input
c93=c19+10 ; kind , name of alternative primary output
c11=c93+10+2 ; size of coretable entry
; definition of a console description format
;c20=def above; next console
;c21=def above; last console
c28=c21+2 ; access count word
c25=c28+2 ; process description word
c26=c25+2 ; priority halfword
c27=c26+1 ; command mask halfword
c29=c27+1 ; process name quadrouple
c30=c29+8 ; first address word
c31=c30+2 ; top address word
c32=c31+2 ; buf claim halfword
c33=c32+1 ; area claim; halfword
c34=c33+1 ; internal claim; halfword
c35=c34+1 ; function mask; halfword
c37=c35+1 ; protection register;halfword
c38=c37+1 ; protection key; halfword
c41=c38+1 ; max interval; double
c42=c41+4 ; standard interval; double
c39=c42+4 ; size; word
c40=c39+2 ; program name; quadrouble
c43=c40+8 ; user interval; double
c95=c43+4 ; primin : kind , name
c96=c95+10 ; primout: kind , name
c44=c96+10 ; entries temp oth device
c45=c44+2 ; segments temp oth device
c46=c45+2 ; entries perm oth device
c47=c46+2; segments perm on 0th device
; ---
;c44+n<3 ; entries temp nth device
;c45+n<3 ; segments temp nth device
;c46+n<3 ; entries perm nth device
;c47+n<3 ; segments perm mth device
c48=c44+a112<3-2; top console description
c1=c48+2 ; size of console description
; meaning of command mask:
; bit 0:(not used)
; bit 1:all bs resources
; bit 2:mode,modify,print,date
; bit 3:job,start,stop,break,dump,list,max,remove,proc,prog,load,read,unstack,i,o
; bit 4:include,exclude
; bit 5:size,pr,pk,login,user,project,,prio,base
; bit 6:addr,function,buf,area,internal,key,bs,temp,perm,all,call
; bit 7:new,create,run,init,
; bit 8:privileged
; bit 9:absolute protection
; bit 10:absolute address
; bit 11:not used
; definition of work area format:
c50=0 ; state (=0=> available: <> 0 => buff addr)
c51=c50+2 ; restart addr
; *** start of part to be saved-restored
c90=c51+2 ; name area
c78=c90+10
c80=c78+2
c91=c80+2 ; remove indicator
c52=c91+2 ; console
c53=c52+2 ; last addr
c54=c53+2 ; char shift
c55=c54+2 ; char addr
c56=c55+2 ; chilel
c57=c56+2 ; core table entry
; *** end of part to be saved-restored
c58=c57+2 ; input stack pointer
c59=c58+2 ; first stack element
; subformat of stack entry:
; name + nta of area
c60=10 ; segment no
c61=c60+2 ; saved last addr
c62=c61+2 ; saved char shift
c63=c62+2 ; saved char addr
c64=c63+2 ; (size of entry)
c71=c16*c64+c59; (top of stack)
c72=c71-c64 ; last stack entry start
c73=c59-c64 ; base of stack
c65=c71+2 ; output buffer start
c66=c65+36 ; input buffer start; often output buffer top
c67=c66+52 ; last addr of buffer
c2=c67+2 ; size of a work area
; the input buffer may be overwritten by output in certain cases
; meaning of work area state:
; state=0 available
; state=buf addr waiting for answer
; procedure type internal
; comment: internal interrupt procedure used during debugging
; of s.
d0:
c.(:c24>23a.1:)-1 ; if internal interrupt then
w. 0,r.a180>1 ; begin
b.i24 w.
am (b4) ;
rl w0 a199<1 ;
jl. w3 d24. ; find console(mainconsole);
jl. 0 ;+2: not found: wait forever;
rs. w1 (i2.) ; console:=main console;
jl. w3 d19. ; init write;
al. w1 i0. ;
jl. w3 d21. ; write text(<:s-break:>);
al. w2 d0. ;
i1: al w0 32 ; next:
jl. w3 d20. ; write char(sp);
rl w1 x2 ;
jl. w3 d22. ; write integer(param);
al w2 x2 +2 ;
se. w2 d0.+a180; if not all printed then
jl. i1. ; goto next;
al w0 10 ;
jl. w3 d20. ; writechar(nl);
jl. w3 d23. ; type line(buf);
al. w1 (i3.) ;
jd 1<11+18 ; wait answer(buf);
jl. (i4.) ; goto end line;
i0:<:<10>s-break:<0>:> ;
i2: e25
i3: e32
i4: g30 ;
e.
z. ; end
b. i20, j20 w.
i0: 0 ; saved link
i1: 0 ; saved w3
i2: 0 ; saved w1
i5: h20 ; first of buffer
j0: g3 ; end line: not allowed
j1: g12 ; end line: area unknown
j2: g15 ; end line: area error
j5: e24 ; pointer to: work
j6: e26 ; pointer to: last addr
j7: e28 ; pointer to: char addr
j8: e27 ; pointer to: char shift
j10: e47 ; pointer to: area input mess
j11: e49 ; pointer to: last of buffer
j12: e50 ; pointer to: segment number
j13: e32 ; pointer to: answer
; procedure stack input
; stacks the input pointers and selects the given area for input
;
; call: w2=name, w3=link
; exit: all regs undef
d79: ; stack input:
rs. w3 i0. ; save return;
rl. w1 (j5.) ; w1 := work;
rl w3 x1+c58 ; w3 := stack pointer;
sn w3 x1+c72 ; if stack pointer = last stack entry then
jl. (j0.) ; goto not allowed; (* i.e. stack overflow *)
al w3 x3+c64 ; increase (stack pointer);
rs w3 x1+c58 ;
rl. w1 (j6.) ;
rs w1 x3+c61 ; save last addr in stack entry;
dl. w1 (j7.) ;
ds w1 x3+c63 ; save char shift and char addr in stack entry;
dl w1 x2+2 ; move name to stack entry;
ds w1 x3+2 ;
dl w1 x2+6 ;
ds w1 x3+6 ;
; prepare variables for immediately buffer change
al w0 -1 ;
rs w0 x3+c60 ; segment.stack entry := -1;
rl. w2 i0. ; w2 := return;
jl. d82. ; goto next segment;
; procedure unstack input
; restores the char pointers from the stack, and maybe also the buffer
;
; call: w2=link
; exit: all regs undef
d80: ; unstack input:
rl. w1 (j5.) ; w1 := work;
rl w3 x1+c58 ; w3 := stack pointer;
sn w3 x1+c73 ; if stack pointer = stack base then
jl x2 ; return;
al w0 x3-c64 ;
rs w0 x1+c58 ; decrease (stack pointer);
dl w1 x3+c63 ;
ds. w1 (j7.) ; restore char shift and char addr from stack entry;
rl w1 x3+c61 ;
rs. w1 (j6.) ; restore last addr from stack entry;
jl. d81. ; goto get segment;
; procedure get segment
;
; call: w2 = link
; exit: w1,w2,w3=unch, w0=undef
d81: ; get segment:
am 0-1 ; increment := 0;
; procedure get next segment
;
; call: w2 = link
; exit: w1,w2,w3=unch, w0=undef
d82: ; next segment:
al w0 1 ; increment := 1;
; procedure read segment
;
; call: w0 = increment, w2 = link
; exit: w1,w2,w3=unch, w0=undef
d83: ; read segment:
ds. w3 i1. ; save return, w3;
rs. w1 i2. ; save w1;
rl. w1 (j5.) ; w1 := work;
rl w3 x1+c58 ; w3 := stack pointer;
sn w3 x1+c73 ; if stack pointer = stack base then
jl. i10. ; goto return;
rl. w1 i5. ; w1 := first of buffer;
al w2 x1+510 ; w2 := last of buffer;
ds. w2 (j11.) ;
sn w0 0 ; if increment <> 0 then
jl. i8. ; begin
rs. w2 (j6.) ; last addr := last of buffer;
rs. w1 (j7.) ; char addr := first of buffer;
al w1 -16 ;
rs. w1 (j8.) ; char shift := -16;
i8: ; end;
wa w0 x3+c60 ; segment := segment + increment;
rs w0 x3+c60 ;
rs. w0 (j12.) ;
jd 1<11+92; create entry lock process(area name);
se w0 0 ; if result <> ok then
jl. (j1.) ; goto area unknown;
al. w1 (j10.) ;
jd 1<11+16; send message (area input, area name);
al. w1 (j13.) ;
jd 1<11+18; wait answer(answer area);
rl w1 x1 ;
lo w1 0 ; w1 := status 'or' result;
jd 1<11+64; remove process (area name);
se w1 1 ; if any arror then
jl. (j2.) ; goto area error;
i10: ; return:
rl. w1 i2. ; restore regs;
dl. w3 i1. ;
jl x2 ; return;
e. ;
; procedure next char(char,type)
; comment: unpacks and classifies the next character from
; the console buffer:
; character type:
; 0 <small letter>
; 1 <digit>
; 2 <radix point or minus sign>
; 3 <space>
; 4 <separator>
; 5 <end line>
; 6 <other graphic>
; 7 <blind>
; call: return:
; w0 char
; w1 type
; w2 destroyed
; w3 link link
b.i24 ; begin
w.d1: dl. w2 e28. ;
sh w1 0 ; if charshift>0 then
jl. i0. ; begin
al w1 -16 ; char shift := -16;
al w2 x2+2 ; char addr := char addr + 2;
sh. w2 (e26.) ; if char addr > last addr then
jl. i0. ; begin
al w0 10 ; char := newline;
rl. w1 e24. ;
rl w2 x1+c58 ;
sn w2 x1+c73 ; if stack pointer = stack base then
jl. i1. ; goto classify char; (* i.e. not end of area-read-buffer *)
jl. w2 d82. ; get next segm;
jl. d1. ; goto next char;
; end;
i0: rl w0 x2 +0 ;
ls w0 x1 +0 ; char:=word(charaddr) shift charshift;
la. w0 i3. ; char:=char(17:23);
al w1 x1 +8 ; charshift:=charshift+8;
ds. w2 e28. ;
i1: ; classify char:
rl w1 0 ;
ls w1 -2 ;
wa. w1 e5. ;
bz w1 x1 +0 ; entry:=byte(chartable+char/4);
so w0 2.10 ; type:=
ls w1 -6 ; if char mod 4=0 then entry(0:2) else
so w0 2.01 ; if char mod 4=1 then entry(3:5) else
ls w1 -3 ; if char mod 4=2 then entry(6:8) else
la. w1 i4. ; entry(9:11);
jl x3 ; end;
i3:8.177 ;
i4:8.7 ;
e. ; end
; procedure next param(type)
; comment: converts and classifies the next parameter from
; the console buffer.
; parameter type:
; 0 <empty>
; 1 <name>
; 2 <integer>
; 3 <unknown>
; call: return:
; w0 type
; w1 unchanged
; w2 unchanged
; w3 link link
b.i24 ; begin
w.d2: rs. w3 e60. ;
ds. w2 e59. ;
al w1 0 ;
se. w1 (e87.) ; if areabuf undef then
jl. w2 d81. ; get segment;
rs. w1 e87. ; areabuf := defined;
al w0 0 ; param type := 0;
ds. w1 e19. ; integer:=0;
ds. w1 e21. ;
ds. w1 e23. ; name:=0
al w0 10 ;
rl. w1 e6. ; radix:=10;
ds. w1 e57. ; state:=param table;
d3: jl. w3 d1. ; continue:
wa. w1 e57. ; next char(char,type);
bz w1 x1 +0 ; entry:=byte(state+type);
al w2 0 ;
ld w2 -2 ; action:=entry(0:9);
ls w2 -19 ;
wa. w2 e6. ; state:=
rs. w2 e57. ; param table+8*entry(10:11);
jl. x1 +d2. ; goto action;
d4: rl. w3 e19. ; letter:
sl w3 11 ; if integer>=10
jl. d7. ; then goto unknown;
al w2 0 ;
wd. w3 i0. ;
ls w2 3 ; char:=char shift
ac w2 x2 -16 ; (16-integer mod 3 * 8);
ls w0 x2 +0 ;
ls w3 1 ; addr:=name+integer/3*2;
lo. w0 x3+e20. ;
rs. w0 x3+e20. ; word(addr):=word(addr) or char;
rl. w3 e19. ;
al w3 x3 +1 ;
al w2 1 ; integer:=integer+1;
ds. w3 e19. ; param type:=1;
jl. d3. ; goto continue;
d5: se w0 45 ; radix or minus
jl. i1. ; if minus thrn
al w3 -1 ;
rs. w3 i4. ;
jl. d3. ;
i1: al w3 0 ;
rx. w3 e19. ; radix:=integer;
rs. w3 e56. ; integer:=0;
jl. d3. ; goto continue;
d6: rl. w3 e19. ; digit:
wm. w3 e56. ;
al w3 x3 -48 ; integer:=
wa w3 0 ; integer*radix-48+char;
al w2 2 ; param type:=2;
ds. w3 e19. ;
jl. d3. ; goto continue;
d11: ; newline or semicolon:
sn w0 10 ;
jl. d8. ; while char <> newline do
jl. w3 d1. ; next char;
jl. d11. ; goto delimiter;
d7: ; unknown:
sn w0 25 ; if char = em then
jl. w2 d80. ; unstack input;
al w2 3 ;
rs. w2 e18. ; param type:=3;
d8: rl. w0 e18. ; delimiter:
rl. w2 e18. ;
se w2 2 ;
jl. i2. ;
rl. w3 i4. ;
sh w3 -1 ;
ac. w3 (e19.) ;
sh w3 -1 ;
rs. w3 e19. ;
rs. w2 i4. ;
i2: dl. w2 e59. ;
c.(:c24>21a.1:)-1 ; if param testoutput then
jd 1<11+28 ; type w0(param type);
z. jl. (e60.) ;
i0:3 ;
i4:0 ;sign
e. ; end
; procedure next name
; comment: checks that the next parameter from the console
; buffer is a name:
; call: return:
; w0 type
; w1 unchanged
; w2 unchanged
; w3 link link
b.i24 ; begin
w.d15:rs. w3 i0. ;
jl. w3 d2. ; next param(type);
se w0 1 ; if type<>1
jl. g2. ; then goto end line;
jl. (i0.) ;
i0:0 ; end
; procedure next integer(integer)
; comment: checks that the next parameter from the console
; buffer is an integer.
; call: return:
; w0 integer
; w1 unchanged
; w2 unchanged
; w3 link link
w.d16:rs. w3 i0. ; begin
jl. w3 d2. ; next param(type);
se w0 2 ; if type<>2
jl. g2. ; then goto end line;
rl. w0 e19. ;
jl. (i0.) ;
e. ; end
; procedure increase access(console)
; comment: increases the access counter of a given console,
; and if the console was in the free pool, it is hooked
; onto the used chain.
; call: return:
; w0 destroyed
; w1 console console
; w2 unchanged
; w3 link unchanged
b. i24 w.
d9: ds. w3 i1. ;
al w0 1 ; begin
wa w0 x1+c28 ;
sh w0 1 ;
al w0 2 ;
rx w0 x1+c28 ; access count:= access count + 1;
i4:; if access count was <> 0
sl. w1 (e31.) ; or console belongs to the predefined
jl. 4 ; then return;
jl. w3 d17. ; remove element(console);
dl. w3 i1. ; return
jl x3 ; end;
; procedure decrease access(console);
; comment: decreases the access counter of a given console,
; and if the access counter becomes null, and the console
; description belongs to the potentially free consoles, it
; is removed from the used chain and hooked onto the
; rear of the free chain.
; call: return:
; w0 unchanged
; w1 console console
; w2 unchanged
; w3 link destroyed
d10: ds. w3 i1. ; begin
rl w3 x1+c28 ;
se w3 2 ;
jl. +8 ;
rl. w2 e81. ;
sn w2 0 ;
al w3 x3 -1 ;
al w3 x3 -1 ; access count:= access - 1;
sh w3 0
al w3 0
rs w3 x1+c28 ;
sn w3 0 ; if access count <> 0
sl. w1 (e31.) ; or console is predefined
jl. i10. ; then return;
al. w2 e35. ;
jl. w3 d18. ; link element(console,free chain);
i10: dl. w3 i1. ; return
jl x3 ;
; end;
i0:0 ; common room for register save
i1:0 ; in increase and decrease access.
i3:c82 ; standard console mask
; procedure remove element(element)
; comment: removes an element from its chain and makes
; it point at itself.
; call: return:
; w0 unchanged
; w1 element element
; w2 old next
; w3 link old last
d17: rs. w3 i2. ; begin
dl w3 x1+c21 ; next(last):= next(element)
rs w2 x3+c20 ; last(next):= last(element)
rs w3 x2+c21 ; next(element):= element;
rs w1 x1+c21 ; last(element):= element;
rs w1 x1+c20 ; return;
jl. (i2.) ; end;
; procedure link element(element,head);
; comment: links a console to the rear of the chain
; defined by head. this is equivalent to linking
; into a chain immediately before the element named
; head.
; call: return:
; w0 unchanged
; w1 element element
; w2 head head
; w3 link old last
d18: rs. w3 i2. ; begin
rl w3 x2+c21 ; rear:= last(head);
rs w1 x2+c21 ; last(element):= last(head)
rs w1 x3+c20 ; next(rear):= element;
rs w2 x1+c20 ; next(element):= head;
rs w3 x1+c21 ; last(element):= rear;
jl. (i2.) ; return;
; end;
i2:0 ; general return for remove and link;
e. ; end
; procedure init write
; comment: prepares the writing of characters in the line buffer
; within the current work area.
; call: return:
; w0 unchanged
; w1 unchanged
; w2 unchanged
; w3 link link
b.i24 ; begin
w.d19:rs. w3 e55. ;
rl. w3 e24. ;
al w3 x3+c65 ;
rs. w3 e45. ; line addr:=work+linebuf;
rs. w3 e46. ; writeaddr:=lineaddr;
al w3 16 ; writeshift:=16;
rx. w3 e55. ;
jl x3 +0 ;
e. ; end
; procedure writechar(char)
; comment: packs the next character in the storage address
; initialized by initwrite.
; call: return:
; w0 char destroyed
; w1 unchanged
; w2 unchanged
; w3 link link
b.i24 ; begin
w.d20:rx. w1 e55. ; if writeshift<0
rx. w2 e46. ; then
sl w1 0 ; begin
jl. i0. ; writeshift:=16;
al w1 16 ; writeaddr:=writeaddr+2;
al w2 x2 +2 ; end;
i0: ls w0 x1 +0 ; char:=char shift writeshift;
se w1 16 ; if writeshift<>16 then
lo w0 x2 +0 ; char:=char or word(writeaddr);
rs w0 x2 +0 ; word(writeaddr):=char;
al w1 x1 -8 ; writeshift:=writeshift-8;
rx. w1 e55. ;
rx. w2 e46. ;
jl x3 +0 ;
e. ; end
; procedure writetext(addr)
; comment: moves a textstring terminated by a null to the
; storage address initialized by initwrite.
; call: return:
; w0 no of chars
; w1 addr destroyed
; w2 unchanged
; w3 link link
b.i24 ; begin
w.d21:ds. w3 e60. ;
al w3 0 ;
al w2 x1 ;
i0: rl w1 x2 ; next word: portion:= word(addr);
al w2 x2 +2 ; addr:= addr + 2;
i1: al w3 x3 +1 ;
al w0 0 ; repeat
ld w1 8 ; ch:= portion shift (-16);
sn w0 0 ; if ch = 0 then
jl. i2. ; goto endtext;
rs. w3 e58. ;
jl. w3 d20. ; write char(ch);
rl. w3 e58. ;
al w1 x1 +8.377 ; portion:= portion shift 8 + 255;
sn w1 -1 ; until portion = 1;
am i0-i1 ;
jl. i1. ; goto next word;
i2: al w0 32 ; end text:
al w1 x3 ;
jl. w3 d20. ; writechar(32);
i6: rl. w1 e58. ;
i7: dl. w3 e60. ;
jl x3 +0 ; end
; procedure writeinteger(integer)
; comment converts a positive integer to a textstring which
; is moved to the storage address initialized by initwrite.
; call: return:
; w0 destroyed
; w1 integer number of digits
; w2 unchanged
; w3 link link
i4:1 000 000 ; powers of ten:
100 000 ;
10 000 ;
1 000 ;
100 ;
10 ;
1 ;
d22: ds. w3 e60. ; begin
sl w1 0 ; if number < 0 then
jl. i10. ; begin
ac w1 x1 ; number:= -number;
am 45-32 ; sign:= <minus>;
i10: al w0 32 ; end
al w3 7 ;
rs. w3 i15. ;
sl w1 0 ; else sign:= <sp>;
sl. w1 (i4.) ; if number = 1 < 23
jl. i12. ; or number > 10 ** 6 then
al w2 12 ; divisor:= 10 ** 6;
al w3 1 ;
i11: sl. w1 (x2 +i4.-2) ; else
jl. +4 ;
jl. i13. ; begin
al w2 x2 -2 ; divisor:= 1;
al w3 x3 +1 ;
jl. i11. ; while number > divisor * 10 do
i12: al w2 0 ; divisor:= divisor * 10;
i13: rs. w3 i15. ;
jl. w3 d20. ; end;
i14: al w0 0 ; writechar(sign);
wd. w1 x2 +i4. ; repeat
al w1 x1 +48 ; digit:= 48 + number // divisor;
rx w1 0 ; number:= number mod divisor;
jl. w3 d20. ; writechar(digit);
al w2 x2 +2 ; divisor:= divisor // 10;
sh w2 12 ; until divisor = 0;
jl. i14. ; comment return via
rl. w1 i15. ;
jl. i7. ; end in writetext
i15: 0 ; number of digits
e. ; end
; procedure typeline(buf)
; comment: starts the output on the current console of the line buffer
; within the current work area.
; call: return:
; w0 destroyed
; w1 destroyed
; w2 buf
; w3 link destroyed
; procedure send buf (mess, buf)
; (as typeline, but at call: w1=mess)
b.i24 ; begin
w.
d23: ; type line:
al. w1 e44. ; mess := output message;
d26: ; send buf:
rs. w3 e60. ;
rl. w2 e25. ;
rl w2 x2+c25 ;
dl w0 x2+a11+2 ;
ds. w0 e41. ;
dl w0 x2+a11+6 ;
ds. w0 e43. ; receiver:=name(proc);
al. w3 e40. ;
jd 1<11+16 ; send mess(receiver,typemess,buf);
jl. (e60.) ;
e. ; end
; procedure find console(device no, console, sorry)
; comment: searches a console with a given process descr. addr.
; call: return:
; w0 cons addr cons addr
; w1 console
; w2 unchanged
; w3 link link
b.i24 ; begin
w.d24:rl. w1 e9. ; for console:=first console
i0: sn w0 (x1+c25) ; step console size
jl x3 +2 ; until last console do
sn. w1 (e10.) ; if device(console)=device no
jl. +6 ; then goto found;
al w1 x1 +c1 ; goto sorry;
jl. i0. ; found:
al. w1 e35. ; if not found then get
rl w1 x1+c20 ; free consolebuffer
sn. w1 e35. ;
jl x3 +0 ;
rs w0 x1+c25 ;
jl x3 +2 ;
e. ; end
; common block for the procedures find parent, find size,
; find addr, and max size. the procedures use the
; variable core table element (e30) as work variable, and
; the three first mentioned procedures leave it pointing
; at a suitable element. i.e. for find parent, e30 points
; at the core table element for the chilet, and for
; find size and find addr, e30 points at an element
; before which a suitable hole may be found.
b. i24, j24
w.
; local sub procedures first hole and next hole(addr, size, sorry);
; comment: this set of procedures perform the actual up
; dating of the variable core table element.
; call: return
; w0: hole addr
; w1: hole size
; w2: unchanged
; w3: link link
j0: rs. w3 e30. ; entry first hole:
rl. w0 e16. ; hole addr:= first core;
al. w3 e15. ; element:= core table head;
jl. j2. ; goto advance;
j1: rx. w3 e30. ; entry next hole:
sn. w3 e15. ; element:= core table element
jl. (e30.) ; if element = core table head then
am (x3+c17) ; return sorry;
rl w0 a18 ; hole addr:= top addr(child(element));
am (x3+c17)
wa w0 a182 ; add base
j2: rl w3 x3+c20 ; advance:
rl w1 x3+c17 ; element:= next(element);
sn. w3 e15. ; if element = core table head
al. w1 e1. ; el then tophole=topcore
rs. w2 i5.
rl w2 x1+a182
rl w1 x1+a17 ; else tophole:= first addr(child(element));
se. w3 e15. ;
wa w1 4 ; add base
ws w1 0 ; hole size:= top hole - hole addr;
rx. w3 e30. ; core table element:= element;
rl. w2 i5. ;
jl x3 +2 ; return happy;
i5: 0
; procedure find parent(child,console,coretableelement,sorry);
; comment: searches the parent console of a given child and
; sets the variable core table element.
; call: return:
; w0: destroyed
; w1: console
; w2: child child
; w3: link core table element
d25: rs. w3 e60. ; begin
am j0-j1 ; for i:= first hole,
i0: jl. w3 j1. ; next hole while happy do
jl. (e60.) ; begin
rl. w3 e30. ; if child = child(element) then
se w2 (x3+c17) ; begin console:= console(element);
jl. i0. ; return happy
rl w1 x3+c18 ; end;
am. (e60.) ; end;
jl +2 ; return sorry;
; end;
; procedure find size(start,size,sorry);
; comment: the core table is searched for the first
; hole not less than the size given. the start address
; is returned and the variable core table entry is set
; to point at the element before which a hole is
; found.
; call: return:
; w0: first addr
; w1: size size (i.e. unchanged)
; w2: destroyed
; w3: link destroyed
d27: rs. w1 e37. ; begin
rs. w3 e38. ; wanted size:= size;
am j0-j1 ; for size:= first hole, next hole while happy do
i1: jl. w3 j1. ; if size >= wanted size then
jl. (e38.) ; goto found;
sl. w1 (e37.) ; return sorry;
jl. 4 ; found: size:= wanted size;
jl. i1. ; first addr:= hole addr;
dl. w2 e38. ; return happy;
jl x2 +2 ; end;
; procedure find addr (start,size,sorry);
; comment: the core table is searched for a hole with
; a given start address and a size not less than given.
; call: return:
; w0: start start (i.e. unchanged)
; w1: size size (i.e. unchanged)
; w2: destroyed
; w3: link destroyed
d28: rs. w1 e57. ; begin
rs. w3 e58. ;
rl w2 0 ;
am j0-j1 ; for size:= first hole, next hole while happy do
i2: jl. w3 j1. ; begin
jl. (e58.) ; if holeaddr > start addr then
sl w0 x2 +2 ; return sorry;
jl. (e58.) ; add := hole addr + hole size
wa w1 0 ; - wanted size;
ws. w1 e57. ; if add >= start then goto found;
sh w1 x2 -2 ; end;
jl. i2. ; return sorry;
al w0 x2 ; found:
dl. w2 e58. ; return happy;
jl x2 +2 ; end;
; procedure find max(size)
; comment: the core table is searched for the size of the largest
; hole, and the size is delivered;
; call: return:
; w0: destroyed
; w1: size
; w2: destroyed
;w3: link destroyed
d29: rs. w3 e58. ; begin
al w2 0 ;
am j0-j1 ; max:= 0;
i3: jl. w3 j1. ; for size:= firsthole,nexthole while happy do
jl. i4. ; if size >= max then
sl w1 x2 ; max:= size;
al w2 x1 ;
jl. i3. ; size:= max;
i4: al w1 x2 ; return
jl. (e58.) ; end;
e.
; procedure reserve core(child)
; comment: inserts a child in the core table just before
; the element pointed at by core table entry. the variable
; core table entry is updated to point at the new element;
; call: return:
; w0 child child
; w1 console
; w2 console core table element
; w3 link destroyed
b.i24 w. ; begin
d30: rs. w3 e60. ; i:= base core table;
rl. w1 e33. ; repeat
i0: al w1 x1+c11 ; i:= i + core table entry size;
se w1 (x1+c21) ; until
jl. i0. ; core table entry(i) is free;
rx. w2 e30. ; link element(core table entry(i),
jl. w3 d18. ; core table element);
al w2 x1 ; core table element:= core table entry(i);
rx. w1 e30. ; core table element. child:= child;
ds w1 x2+c18 ; core table element. console:= console;
rl. w3 e79. ;
rs w3 x2+c22 ; coretable element. segm:=segmentno
al w3 -1 ;
rs. w3 e79. ;
rl w0 x2+c17 ;
jl. (e60.) ; return;
e. ; end;
; procedure release core(child)
; comment: removes a child from the core table;
; call: return:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed
b.i24 w. ; begin
d31: rs. w3 i1. ;
rl. w1 e30. ;
al w2 -1 ;
rs w2 x1 c22 ;
rl w1 x1+c18 ; console:= core table element.console;
jl. w3 d10. ; decrease access(console);
rl. w1 e30. ;
jl. w3 d17. ; release element (core table element);
jl. (i1.) ; return
i1:0
e. ; end
c.-4000 ; only in rc4000
; procedure find keys(keys,pr,pk,sorry)
; comment: examines all children and creates a possible
; protection register with zeroes in all available protection
; bits. from this possible register, a protection register pr
; with a given number of keys is selected from left to right.
; the protection key pk is set equal to the right-most assigned
; key. upon return, keys is diminished by the number of assigned
; keys.
; call: return:
; w0 pr
; w1 pk
; w2 keys keys
; w3 link link
b.i24 ; begin
w.d32:ds. w3 e60. ;
rl w1 b1 ;
bz w0 x1+a24 ; possible:=pr(s);
al. w2 e15. ; addr:=core table;
i0: rl w2 x2+c20 ; while word(addr)<>0 do
sn. w2 e15. ; begin
jl. i2. ; child:=word(addr);
rl w3 x2+c17 ;
bz w3 x3+a24 ; possible:=possible or
lx. w3 i1. ; (pr(child) exor last 7);
lo w0 6 ; addr:=addr+2;
jl. i0. ;
i1:8.177 ;end;
i2: rl. w2 e59. ; pr:=possible;
al w3 0 ;
i3: ls w0 1 ; bit:=16;
al w3 x3 -1 ; repeat
sz w0 1<7 ; bit:=bit+1;
jl. i4. ; if pr(bit)=0 then
al w2 x2 -1 ; begin
sn w2 0 ; keys:=keys-1;
jl. i5. ; if keys=0 then goto found;
i4: se w3 -7 ; end;
jl. i3. ; until bit=24;
jl. (e60.) ; goto sorry;
i5: lo. w0 i1. ; found: pk:=bit;
ls w0 x3 +0 ; while bit<>24 do
ac w1 x3 +0 ; begin
rl. w3 e60. ; pr(bit):=1; bit:=bit+1;
jl x3 +2 ; end;
e. ; end
z.
; procedure child name
; comment: moves child name to receiver name.
; call: return:
; w0 destroyed
; w1 destroyed
; w2 child
; w3 link link
b.i24 ; begin
w.d33:rl. w2 e29. ;
dl w1 x2+a11+2 ;
ds. w1 e41. ;
dl w1 x2+a11+6 ; receiver:=name(child);
ds. w1 e43. ;
jl x3 +0 ;
e. ; end
; procedure check child
; comment: checks that the process name in the console
; description refers to a child of s. the console must
; either be a privileged console or the parent of the
; child.
; call: return:
; w0 destroyed
; w1 console
; w2 child
; w3 link destroyed
b.i24 ; begin
w.d34:rs. w3 i0. ;
rl. w1 e25. ;
al w3 x1+c29 ; process description(
jd 1<11+4 ; process name(console),result);
rs. w0 e29. ; child:=result;
rl w2 0 ;
rl w1 x2 +0 ;
se w2 0 ; if child=0
se w1 0 ; or kind(child)<>0
jl. g9. ; then goto end line;
jl. w3 d25. ;
jl. g3. ; find parent(child,parent,end line);
sn. w1 (e25.) ;
jl. (i0.) ; if console<>parent
rl. w1 e25. ;
bz w0 x1+c27 ; and not privileged(console)
so w0 1<3 ;
jl. g3. ; then goto end line;
jl. (i0.) ;
i0:0 ;
e. ; end
; procedure create child
; comment: allocates resources and creates a child process in
; accordance with the console parameters. the child is included as
; user of all devices in the device table. finally, the identification
; bit of the child is set in the description of the console.
; call: return:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed
b.i25, j10 w. ; begin
d35:rs. w3 i2. ; find core:
el. w2 e81. ;
se w2 1 ;
jl. w3 d9. ;
rl. w2 e25. ;
rl w0 x2+c30 ; start:=first addr(console);
rl w1 x2+c39 ; size:=size(console);
bz w3 x2+c27 ;
sz w3 1<1 ; if abs addr(console)
am d28-d27 ; then find addr(start,size,end line)
jl. w3 d27. ; else find size(start,size,end line);
jl. g4. ;
rl. w2 e25. ;
rs w0 x2+c30 ; first addr(console):=start;
wa w0 x2+c39 ; top addr(console):=
rs w0 x2+c31 ; start+size(console);
bz w3 x2+c27 ; find protection:
c.-4000 ; in rc4000:
sz w3 1<2 ; if not abs protection(console) then
jl. i0. ; begin
bz w2 x2+c26 ;
jl. w3 d32. ; find keys(keys(console),
jl. g8. ; new pr,new pk, end line);
rl. w2 e25. ; pr(console):=new pr;
hs w0 x2+c37 ; pk(console):=new pk;
hs w1 x2+c38 ; end;
i0: bl w0 x2+c37 ;
sz w0 -1<8 ; if pr(console)(0:3)<>0 then
jl. g8. ; goto end line;
z.
c.8000 ; in rc8000:
rl. w0 i21. ;
so w3 1<2 ; if abs protection
jl. j1. ;
so w3 1<9 ; and allowed(console)
jl. g3. ;
al w0 0 ; then pr,pk=0,0 else
j1: rs w0 x2+c37 ; pr,pk=240<12+7 , usermode
z.
rl w3 b1 ; check claims:
bz w0 x2+c32 ;
bz w1 x3+a19 ;
ws. w1 e2. ; if buf claim(console)>
sl w0 x1 +1 ; buf claim(s)-own buf
jl. g5. ; then goto end line;
bz w0 x2+c33 ;
bz w1 x3+a20 ; if area claim(console)>
ws. w1 e3. ;
sl w0 x1 +1 ; area claim(s)-own area
jl. g6. ; then goto end line;
bz w0 x2+c34 ;
bz w1 x3+a21 ; if internal claim(console)>
sl w0 x1 +0 ; internal claim(s)-1
jl. g7. ; then goto end line;
; test intervals:
; comment: the testing that the interval limits are contained
; in each other is performed as schetched below
; standard: !2!
; 4 1
dl w1 x2+c42+2 ; the numbers refer to the numbers about
sh w1 (x2+c43+2) ; 1; if cons.std.hi >= cons.user.hi
sl w0 x1 +1 ;
jl. g19. ; then goto base alarm;
rl w1 x2+c43 ;
sl w1 (x2+c41) ; 3; if cons.user.lo < cons.max.lo
jl. 4 ;
jl. g19. ;
ws w1 0 ;
sl w1 1 ;
jl. g19. ; then goto base alarm;
dl w1 x2+c41+2 ;
al w1 x1 +1 ;
sl w0 (x3+a45-2) ; 6; or cons.max.hi < cons.user.hi
sh w1 (x2+c43+2) ; then goto base alarm;
jl. g19. ;
al w1 x1 -2 ;
sl w1 (x3+a45-0) ; 7; if cons.max.hi > s.std.hi
jl. g19. ; then goto base alarm
i25: al w1 x2+c30 ; create internal process(
al w3 x2+c29 ; process name(console),
jd 1<11+56 ; first addr(console),result);
sn w0 1 ;
jl. g4. ;
sn w0 2 ;
jl. g11. ;
se w0 0 ; if result<>0
jl. g10. ; then goto end line;
jd 1<11+4 ; process description(
rs. w0 e29. ; process name(console),result);
jl. w3 d30. ; reserve core
al w3 x1+c95 ; move kind,name of primin
al w2 x2+c19 ; and primout to coretable
j0 : rl w0 x3 ; (set by i and o commands )
rs w0 x2 ;
al w3 x3+2 ;
al w2 x2+2 ;
se w3 x1+c44 ;
jl. j0. ;
; set the priority of the process
; if the priority differs from default. (0)
al w3 x1+c29 ; name adr=process name.console
zl w1 x1+c26 ; prio=prio.console
sn w1 0 ; if prio<> 0 then
jl. i19. ;
jd 1<11+94 ; set priority
sn w0 0 ; if result <> 0 then
jl. i19. ;
jl. w3 d40. ; remove process
jl. g27. ; goto end line
; include process as user of all peripheral devices except those listed
; in the s device exception tablr.
i19: rl. w2 e11. ; addr:=start(exception table);
al w1 0 ; devno:=0;
i1: bz w0 x2 ; include:
se w0 x1 ; if devno:=devno(addr) then
jl. i3. ; addr:=addr+1;
al w2 x2+1 ; else
jl. i4. ;
i3: jd 1<11+12 ; include user(name addr, devno);
i4: al w1 x1+1 ; devno:=devno+1;
se w1 a127 ; if devno<>number of peripheral processes then
jl. i1. ; goto include;
; give the child the required backing storage claims
; if claims cannot be granted, the process is
; removed and an alarm message is issued
rl. w2 e25. ;
al w3 -1 ;
rs. w3 e79. ;
bz w0 x2+c27 ;
so w0 1<10 ; if all bs (console)
jl. i8. ; then begin
c.(:c23>16 a.1:)-1
rl w3 b22 ;
i5: rs. w3 i11. ; next device:
rl w3 x3 ; w3:= chaintable
rl w0 x3-a88+16 ;
sn w0 0 ; if chaintable <> free
jl. i7. ; then begin
dl w1 x3-a88+18 ;
ds. w1 e21. ;
dl w1 x3-a88+22 ;
ds. w1 e23. ; work device:= docname(chaintab)
rl w1 x3-a88+26 ; slicelength(chaintab)
rs. w1 i12. ; =: slicelength
rl w3 x3-a88-2 ; claims rel(chaintab)
wa w3 b1 ; + cur proc
rs. w3 i9. ; =: claims
al. w2 e51. ;
i6: bz w1 x3 ; move claims
rs w1 x2 ;
bz w1 x3 +1 ;
wm. w1 i12. ;
rs w1 x2 +2 ;
al w2 x2 +4 ;
al w3 x3 +2 ;
am. (i9.) ;
sh w3 a110*2 ;
jl. i6. ;
rl. w2 e25. ;
al w3 x2+c29 ;
al. w2 e20. ;
al. w1 e51. ;
jd 1<11+78 ;
se w0 0 ; if result<>0
jl. g20. ;
i7: rl. w3 i11. ;
al w3 x3 +2 ; chaintab:= chaintab + 2
se w3 (b24) ; if chain <> chain end
jl. i5. ; then goto next device
jl. (i2.) ; return
i9:0
i12:0 ;
i11:0 ; end
z. ;
jl. g18. ;
i21: 240<12 + 7 ; pr,pk usermode
; transfer claims to child,
; the claimlist in the console-description
i8: ; not 'all' bs (console):
rl. w3 e25. ; w3 := claimbase := console;
i13: ; next chaintable:
rs. w3 i22. ; save claimbase;
dl w1 x3+c44+6 ; perm claim := claimlist(claimbase);
ds. w1 i24. ;
wa w0 x3+c44+0 ; temp entries := temp+perm entry claim;
wa w1 x3+c44+2 ; temp segms := temp+perm segm claim;
rs. w0 i23. ; main entries := temp entries;
al w0 0 ; temp entries := 0;
ws. w3 e25. ; w3 := index in claimlist;
ls w3 -2 ;
wa w3 b22 ; w3 := chain table number;
sl w3 (b24) ; if all chains handled then
jl. (i2.) ; return;
rl w3 x3 ; w3 := chain table addr;
al. w2 g20. ; error addr := claims exceeded;
i14: ; transfer claim:
; w0=temp entries, w1=temp segments
; w2=error address
; w3=chaintable address
rs. w2 i20. ; save(error addr);
al w2 0 ; key := 0;
i15: ; next key:
ds. w1 x2+e52. ; claim(key) := entries,segments;
al w2 x2+4 ; increase(key);
sn w2 a109*4 ; if key = min aux key then
dl. w1 i24. ; entries,segments := perm claim;
sh w2 a110*4 ; if key <= max cat key then
jl. i15. ; goto next key;
dl w1 x3-a88+18 ; name := docname.chaintable;
ds. w1 e21. ;
dl w1 x3-a88+22 ;
ds. w1 e23. ;
rl. w3 e25. ; w3 := proc name;
al w3 x3+c29 ;
al. w2 e20. ; w2 := docname;
al. w1 e51. ; w1 := claim;
jd 1<11+78; set bs claim;
sn w0 0 ; if result = ok then
jl. i16. ; goto maincat entries;
se w0 1 ; if result <> claims exceeded then
jl. i17. ; goto next entry;
al w0 1 ;
hs. w0 e81. ; fiddle with remove indicator...
jl. w3 d40. ; remove child;
jl. (i20.) ; goto error;
i16: ; maincat entries:
ld w1 -100 ; perm claim := 0,0;
ds. w1 i24. ;
rx. w0 i23. ; w0 := main entries; main entries := 0;
rl w3 b25 ; w3 := main catalog chain table;
al. w2 g25. ; w2 := error addr := no maincat entries;
se w0 0 ; if main entries <> 0 then
jl. i14. ; goto transfer claim;
i17: ; next entry:
rl. w3 i22. ; increase (claimbase);
al w3 x3+8 ;
jl. i13. ; goto next chaintable;
i20: 0 ; error addr
i22: 0 ; claimbase
i23: 0 ; main entries;
i24=k+2, 0,0 ; perm claim (entries, segments)
i2:0 ; end
e. ; end
; procedure modify child(addr)
; comment: modifies the registers of the current child as follows:
; child w0 = 0 or process description of parent console
; child w1 = process description of s
; child w2 = process description of parent console
; child w3 = process description of child
; child ex = 0
; child ic = addr
; call: return:
; w0 addr destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed
b.i24 ; begin
w.d36:rs. w3 i0. ;
rs. w0 e66. ; child ic:=addr;
rl w0 b1 ;
rs. w0 e62. ; child w1:=s;
jl. w3 d33. ; child name;
jl. w3 d25. ; find parent(child,console,coretableelement,
am 0 ; irrelevant);
rl w1 x1+c25 ;
rs. w1 e61. ; child w0:= child w2;
ds. w2 e64. ; child w3:=child;
; override these default w0 and w2 assignments,
; in case of user-defined primary input (or -output) names
al w1 x3+c19 ; w1 := addr of primary input descr;
rl w0 x1+2 ;
se w0 0 ; if name defined then
rs. w1 e61. ; child w0 := primary input descr;
al w1 x3+c93 ; w1 := addr of primary output descr;
rl w0 x1+2 ;
se w0 0 ; if name defined then
rs. w1 e63. ; child w2 := primary output descr;
al. w1 e61. ;
al. w3 e40. ; modify internal process(
jd 1<11+62 ; receiver, child w0);
jl. (i0.) ;
i0:0 ;
e. ; end
; procedure load child
; comment: loads a program from backing store into
; a child process in accordance with the console parameters.
; the program must be described as follows in the catalog:
; <size of area>
; <6 irrelevant words>
; <first segment to load>
; <content=3><instruction counter>
; <bytes to load>
; call: return:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed
b.i24 ; begin
w.d37: ; create and look up:
rl. w1 e29. ; if state.process <> wait start
zl w1 x1+a13 ; then goto error
so w1 2.100000 ;
jl. g3. ;
rl. w2 e25. ;
dl w1 x2+c40+2 ;
ds. w1 e41. ;
dl w1 x2+c40+6 ;
ds. w1 e43. ; receiver:=prog(console);
d75: rs. w3 i20. ;
rl. w3 e29.
dl w1 x3+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 e40. ;
jd 1<11+52 ; create area process(prog)
al. w3 i1. ; prevent remove of process
sn w0 2 ; if result=2 or
jl. i10. ;
sn w0 3 ; result=3 or
jl. i9.
se w0 0 ; result<>0 then
jl. i11. ; goto give up
al. w3 e40. ;
al. w1 e51. ; look up entry(
jd 1<11+42 ; receiver,tail,result);
sn w0 2 ; if result=2
jl. i10. ; then goto give up 0;
rl. w2 e29. ; check description:
bz. w0 e59. ;
se w0 3 ; if content(tail)<>3
sn w0 8 ; and content(tail)<>8
sz ;
jl. i11. ; then goto give up 0;
rl w0 x2+a17 ; first addr(area mess):=
wa w0 x2+a182
rl. w1 e60. ; first addr(child);
al w1 x1+511 ;
as w1 -9 ; load size:=
as w1 9 ; (bytes(tail)+511)/512*512;
wa w1 0 ; last addr(area mess):=
al w1 x1 -2 ; first addr(child)+load size-2;
am (x2+a182) ; add base
sl w1 (x2+a18) ; if last addr(area mess)>=
jl. i13. ; top addr(child)
ds. w1 e49. ; then goto give up 0;
rl. w1 e58. ; segment(area mess):=
rs. w1 e50. ; segment(tail);
bz. w1 e67. ;
wa w1 0 ; child ic:=
rs. w1 e66. ; first addr(child)+ic(tail);
am (x2+a182)
sl w1 (x2+a18) ; if child ic>=top addr(child)
jl. i13. ; then goto give up 0;
al. w1 e47. ; load program:
jd 1<11+16 ; send mess(receiver,area mess,buf);
al w1 0 ; (prepare for clearing last of command table)
sh. w0 (e8.) ; if first addr of child <= last of initcat code then
rs. w1 (e12.) ; terminate command-table with a zero;
; (i.e. prohibit further use of initcat-commands)
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
jl. i14. ; then goto give up 0;
al. w3 e40. ;
jd 1<11+64 ; remove process(receiver,result);
rl. w0 e66. ;
jl. w3 d36. ; modify child(child ic);
rl. w2 e25. ;
dl w1 x2+c43+2 ; set catalog base
al. w3 e40. ; set catalog base(version,result)
jd 1<11+72 ;
jl. i15. ; goto restore base(s)
i9: am 2 ;
i10: am 2 ;
i11: am 2 ;
i12: am 2 ; area reserved
i13: am 2 ; program too big
i14: rl. w2 i16. ; area error
rs. w2 i20. ; store exit
jd 1<11+64 ; remove process(prog)
i15: dl. w1 i2. ; restore base(s)
al. w3 i1. ;
jd 1<11+72 ;
jl. (i20.) ; exit
i1: 0
a107
i2: a108-1
i3 : 2.100000 ; state bit : wait for stop or start
i20: 0
i16: g15 ; 0
g14 ; +2
g13 ; +4
g12 ; +6
g11 ; +8
g29 ; +10
e.
; procedure start child
; comment: starts a child process.
; call: return:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed
b.i24 ; begin
w.d38:rs. w3 i0. ;
jl. w3 d33. ; child name;
al. w3 e40. ;
jd 1<11+58 ; start internal process(receiver,result);
jl. (i0.) ;
i0:0 ;
e. ; end
; procedure stop child
; comment: stops a child process.
; call: return:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed
b.i24 ; begin
w.d39:rs. w3 i0. ;
jl. w3 d33. ; child name;
al. w3 e40. ;
jd 1<11+60 ; stop internal process(receiver,buf,result);
al. w1 e51. ;
jd 1<11+18 ; wait answer(buf,answer,result);
jl. (i0.) ;
i0:0 ;
e. ; end
; procedure remove child
; comment: excludes a child as a user of all devices and
; removes it.
; call: return:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed
b.i24 ; begin
w.d40:rs. w3 i1. ;
jl. w3 d33. ; child name;
jl. w3 d25. ; find parent(child,console,
am 0 ; irrelevant);
al. w3 e40. ;
jd 1<11+64 ;
se w0 0 ; if result not ok then
jl. g11. ; write out catalog error
jl. w3 d31. ; release core
jl. (i1.) ;
i1:0 ;
e. ; end
; procedure find work(state,work)
; comment: searches a work area in a given state.
; call: return:
; w0 unchanged
; w1 work
; w2 state state
; w3 link link
b.i24 ; begin
w.
d41: ; find work:
rl. w1 e13. ; work := first work;
i0: ; loop:
rs. w1 e24. ;
sn w2 (x1+c50) ; if state(work) = state then
jl x3 ; return;
al w1 x1+c2 ; increase(work);
sh. w1 (e14.) ; if work <= last work then
jl. i0. ; goto loop;
jl. g31. ; goto exam next; <* not expecting this answer *>
e. ; found:
; end;
; procedure save work(state)
; comment: saves a state and a number of variables in the
; current work area and proceeds to examine the event queue.
; call: return:
; w0 destroyed
; w1 work
; w2 state destroyed
; w3 link link
b.i24 ; begin
w.d42:rl. w1 e24. ; state(work):=state;
ds w3 x1+c51 ; interrupt addr(work):=link;
rs. w2 e88. ; expected answer := state;
c.(:c24>19a.1:)-1 ; if work testoutput
jd 1<11+32 ; then type w2(state);
z. al. w2 e20. ;
i0: rl w0 x2 +0 ;
rs w0 x1+c90 ; save(console)
al w1 x1 +2 ; to(core addr)
al w2 x2 +2 ; in(work);
sh. w2 e30. ;
jl. i0. ;
rl. w3 e2. ;
al w3 x3 -1 ; own buf:= own buf-1
rs. w3 e2. ;
jl. g30. ; goto exam first;
e. ; end
; procedure restore work(work, state)
; comment: restores a number of variables from a work area
; and jumps to the interrupt address.
; call: return:
; w0 logical status
; w1 work
; w2 state
; w3 link
;
; return address: link + 0 : status <> 0
; link + 2 : status = 0
b.i24 ; begin
w.d43:rl. w1 e24. ;
al. w2 e20. ;
rs. w2 e87. ; areabuf := undef;
i0: rl w0 x1+c90 ;
rs w0 x2 +0 ; restore(console)
al w1 x1 +2 ; to(core addr)
al w2 x2 +2 ; from(work);
sh. w2 e30. ;
jl. i0. ;
rl. w1 e24. ; state:=state(work);
al w2 0 ; state(work):=0;
rx w2 x1+c50 ;
rl. w3 e2. ;
al w3 x3 +1 ; own buf:= own buf+1
rs. w3 e2. ;
rl. w0 e59. ; w0 := logical status;
se w0 1<1 ; if status <> 0 then
jl (x1+c51) ; goto interrupt addr(work);
am (x1+c51) ; goto 2 + interrupt addr(work);
jl +2 ;
e. ; end
; procedure type description
; comment: testoutput of a console description
; call: return:
; w0 unchanged
; w1 destroyed
; w2 destroyed
; w3 link destroyed
c.(:c24>18a.1:)-1 ; if console testoutput then
b.i24 ; begin
w.d44:rs. w3 i1. ;
rl. w1 e25. ;
al w2 x1 +0 ; addr:=console;
i0: bz w3 x2 +0 ; repeat
jd 1<11+34 ; type w3(byte(addr));
al w2 x2 +1 ; addr:=addr+1
se w2 x1 +c1 ; until addr=console+console size;
jl. i0. ;
jl. (i1.) ;
i1:0 ;
e. ;
z. ; end
; procedure next bitnumbers(bits, type)
; comment: converts a sequence of integers from the console buffer
; and sets the corresponding bits in a word equal to one.
; call: return:
; w0 type
; w1 unchanged
; w2 bits
; w3 link link
b.i24 ; begin
w.d45:rs. w3 i1. ;
al w2 0 ; bits:=0;
i0: jl. w3 d2. ; next bit:
se w0 2 ; next param(type);
jl. (i1.) ; if type=2 then
ac. w3 (e19.) ; begin
al w0 1 ;
ls w0 x3 +23 ; bits(23-integer):=1;
lo w2 0 ; goto next bit;
jl. i0. ; end;
i1:0 ;
e. ; end
; procedure clear claimlist
; comment sets zeroes in whole claimlist of console descr
;
; call: w3 = link
; exit: all regs undef
b. i10 w.
d46: ; clear claimlist:
rl. w1 e25. ; w1 := console;
al w2 x1+c48-c44+2; w2 := rel top of claimlist;
al w0 0 ;
i0: ; rep:
al w2 x2-2 ; decrease(pointer);
sl w1 x2 ; if pointer <= start of console then
jl x3 ; return;
rs w0 x2+c44 ; claimlist(pointer) := 0;
jl. i0. ; goto rep;
e.
; procedure devno(name adr. , devno*8, sorry)
; comment: search the chaintable for a given name and
; returns deviceno.*8 (relative adr. for claim list in console table )
; and chaintable address ,
; or returns sorry if name not found.
; call: return:
; w0 destroyed
; w1 destroyed
; w2 name adr. deviceno.*8
; w3 link chaintable adr.
;
b. i10, j10
w.
d61: rs. w3 i0. ;
al w1 -2 ;
rs. w1 i1. ;
j1: rl. w3 i1. ; next chaintable
al w3 x3+2 ;
rs. w3 i1. ;
wa w3 b22 ; get adr of next chaintable
; if adr. of next chaintable
sl w3 (b24) ; >= top of chaintable then
jl. (i0.) ; return sorry
rl w3 x3 ; begin compare names
dl w1 x3-a88+18 ; if name(chaintable)
sn w0 (x2) ; = name(adr.)
se w1 (x2+2) ; then return happy
jl. j1. ; else get next chaintable
dl w1 x3-a88+22 ;
sn w0 (x2+4) ;
se w1 (x2+6) ;
jl. j1. ;
rl. w2 i1. ;
ls w2 2 ;
rl. w1 i0.
jl x1+2
i0: 0
i1: 0
e.
c.(: c23>19 a.1:) -1 ; if list option then
b.i24 ; begin
; block for the list option
;
; procedure writespace(no of spaces)
; comment this procedure writes out a number of spaces <32>
; call return
; w0 destroyed
; w1 c no of spaces
; w2 unchanged
; w3 link link
;
w. d70: rs. w3 i1. ;
i10: al w0 32 ; while no of spaces>=0
jl. w3 d20. ; do
al w1 x1 -1 ;
se w1 0 ; writechar space
jl. i10. ;
jl. (i1.) ;
;
;
; procedure writeint(integer,type)
; comment this procedure left justify an integer in
; a 8 or 4 chars space filled field, according to type
; call return
;w0 type destroyed
;w1 integer no of positions
;w2 unchanged
;w3 link link
;
d71: ds. w0 i0. ; save registers
jl. w3 d22. ; writeinteger(integer)
ws. w1 i0. ;
sl w1 0 ; fill with spaces
jl. (i1.) ; according to type
ac w1 x1 ;
jl. i10. ; return through writespace
i1:0
i0:0
e.z.
c.(:c23>14a.1:)-1
b. i24
;
; procedure get_segment(segno)
; comment: performs the transport of the stated segment
; from <:susercat:>
; call: return
; w0 destroyed
; w1 segno destroyed
; w2 address destroyed
; w3 link destroyed
w.d77: ; get_segment:
rs. w3 i10. ;
al. w3 c69. ;
jd 1<11+52 ; create areaprocess(susercat)
sl w0 2 ; if result <> 0
jl. g12. ; then goto end line
se w0 0 ;
jl. g6. ;
i22: rs. w1 e50. ;
al. w1 e47. ;
rs. w2 e48. ;
al w2 x2+512 ; prepare inputmessage
rs. w2 e49. ;
jd 1<11+16 ; send message
al. w1 e51. ;
jd 1<11+18 ;
lo. w0 e51. ; 'or' status and result
rl w1 0 ; save result
jd 1<11+64 ; remove area.susercat
se w1 1 ; if <>1 then
jl. g11. ; error goto end line
jl. (i10.) ;
i10:0
; procedure find_entry(name)
; comment: finds the entry identified by the given name
; returns with the value -10 if entry not found in this segment or -1 if entry not exist
; call: return:
; w0 destroyed
; w1 destroyed
; w2 entry address or -10 or -1
; w3 link destroyed
w. d78: ; find_entry:
rs. w3 i10. ;
rl. w1 e71. ;
i0: rl w2 x1 ; if entry not exsist
sn w2 -1 ;
jl. (i10.) ; then return
sn w2 -2 ; if entry deleted then
jl. i1. ; try next entry
al w2 x1 ;
dl w0 x1 +6 ;
sn. w3 (e20.) ; compare names
se. w0 (e21.) ;
jl. i1. ; if names unequal then
dl w0 x1+10 ; try next entry
sn. w3 (e22.) ; else return
se. w0 (e23.) ;
jl. i1.
jl. (i10.) ; entry found
i1: rl. w2 e70. ;
al w2 x2 +2 ;
rl. w3 e71. ;
wa w1 x2 ;
am. (e85. ;
sl w3 x1 ;
jl. i0. ;
al w2 -10 ; entry not found
jl. (i10.) ;
e.z.
; parameter table:
; contains a byte for each character type in the follwoing states:
; 0 initial state
; 1 after letter
; 2 after digit
; each entry defines the address of an action (relative to the
; procedure next param) and a new state:
; entry=action<2 + new state
b.i24
i0=(:d3-d2:)<2+0, i1=i0+1, i2=i0+2
i3=(:d4-d2:)<2+1, i4=(:d5-d2:)<2+2, i5=(:d6-d2:)<2+2
i6=(:d7-d2:)<2+0, i7=(:d8-d2:)<2+0
i9=(:d11-d2:)<2+0
; initial state:
h.h1: i3, i5, i4, i0 ; letter 1, digit 2, unknown 0, continue 0
i6, i9, i6, i0 ; unknown 0, endline, unknown 0, continue 0
; after letter:
i3, i3, i6, i7 ; letter 1, letter 1, radix 0, delimit 0
i7, i9, i6, i1 ; delimit 0, endline, unknown 0, continue 1
; after digit:
i6, i5, i4, i7 ; unknown 0, digit 2, radix 2, delimit 0
i7, i9, i6, i2 ; delimit 0, endline, unknown 0, continue 2
e.
jl. d2. ;
d2=k-2
jl. d9. ;
d9=k-2
jl. d10. ;
d10=k-2
jl. d15. ;
d15=k-2
jl. d16. ;
d16=k-2
jl. d19. ;
d19=k-2
jl. d20. ;
d20=k-2
jl. d21. ;
d21=k-2
jl. d22. ;
d22=k-2
jl. d23. ;
d23=k-2
jl. d25. ;
d25=k-2
jl. d26. ;
d26=k-2
jl. d27. ;
d27=k-2
jl. d29. ;
d29=k-2
jl. d32. ;
d32=k-2
jl. d34. ;
d34=k-2
jl. d35. ;
d35=k-2
jl. d36.
d36=k-2
jl. d38.
d38=k-2
jl. d39. ;
d39=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. d79. ;
d79=k-2
c69:<:susercat:>, 0, 0 ; name of s-usercat, incl. name table table entry
▶EOF◀