|
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: 102144 (0x18f00)
Types: TextFile
Names: »ms1 «
└─⟦9ccaf6601⟧ Bits:30008165 Bånd med SW8000 kildetekst/release værktøjer
└─⟦2ba378e4a⟧
└─⟦this⟧ »ms1 «
\f
m. mons1 - operating system s, part 1 17.0 beta
;88.05.06 14.30 kak max buffer in connect dlc/ioc included
;88.05.24 07.50 kak change of cpa and address base included
;88.06.07 08.00 kak prepare dump included
;88.06.14 10.00 kak initialize main included
;88 10 03 15.02 hsi wait 1 second after each start command (c mixup)
;88 10 12 09.55 kak two new commands: privileged and unprivileged introducted
;88 11 09 12.26 kak error in find console corrected
;89 01 17 13.50 kak create child corrected: no bit 2 check if abs protection
; description of command mask updated
;89 02 27 08.30 kak d59 insert in list of dummy names; used if ioc/lan is not included
;89 03 13 14.06 kak the last char read is saved, and may be used to detect end of line
; in commands with a variable number of paramters
;89 05 31 13.15 hsi set stack depth to 3, as in release 81
;90 09 06 08.40 kak *********************** RELEASE 17.0 ************************************
;90 09 06 08.41 kak procedure find parent console changed:
; if the child is found in the coretable, the monitor procedure
; process_description(console_name,pda) is called,
; and the returned pda is used, if the process does not exist the main console is used.
; the main declaration changed: g127 increased to g128
;91 01 30 13.46 kak the change from 90.09.06-08.41 is modified: the selection of the main console is moved to type_line (d23).
b.i30 w.
i0=91 02 01
i1=11 53 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, b1, h50,g128,f29,e109,d90, l90,c107,u109, v109, r105
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= 3 ; 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
c.(:a399>23a.1:)-1
c12= 8.0003 0000 ; standard size mod 2k :=0;
z.
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
c84=-1 ; devno of 1st connection (select a free)
c89=8+12*a112 ; standard length of susercatentry
c100=1 ; number of privileged conseles
c.(:a399>21a.1:)-1
c107=162 ; min size for memory dump (prepare dump - dump)
z.
c15=k, <:disc:>,0,0 ; standard work device name
c36=k, <:slogarea:>, 0 ; default log-area of s
; 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 terminal (subprocess)
c106=c18+2 ; name of terminalprocess
c22=c106+8 ; 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
c75=c27+1 ; terminal name quadrouple
c29=c75+8 ; 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
c97=c96+10 ; first logic address
c98=c97+2 ; cpa limit
c44=c98+2 ; 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; last of console description
c1=c48+2 ; size of console description
;last part of console buffer will be cleared at each call of
; new , all , get or job.
c49=c95 ; first parameter to be cleared
; 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,get,removelink
; bit 4:include,exclude
; bit 5:size,pr,pk,login,user,project,,prio,base,relocate
; bit 6:addr,function,buf,area,internal,key,bs,temp,perm,all,call,
; connect, disconnect, initkit, link, linkall, unlink,cpa,memdump,preparedump
; bit 7:new,create,run,init,createlink
; bit 8:privileged: autorel,closec,lock,jobremove,privileged,unprivileged,cleanup,unlock
; 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 ; used in list, connect, disconnect,linkall
c80=c78+2
c79=c80+2 ; segment in susercat
c91=c79+2 ; continue indicator
c83=c91+2 ; subroutine return address
c92=c83+4 ; cur catalogbase: lower upper limit
c52=c92+2 ; console
c53=c52+2 ; last addr
c54=c53+2 ; char shift
c55=c54+2 ; char addr
c56=c55+2 ; chilel
c74=c56+2 ; terminal address
c101=c74+2 ; device no of disc containing description
c102=c101+2 ; physical disc device no
c103=c102+2 ; pointer in disc description
c105=c103+2 ; size of log disc description
c57=c105+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
; cur catalog base lower limit
c68=12 ; upper limit
c60=c68+2 ; 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+46 ; 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 ;
rs. w0 (i5.) ; terminal:=main console;
jl. w3 d24. ; find_and_select_console_1(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);
al w2 -1 ; executing reentrant code := true;
rs. w2 (i6.) ;
jl. (i4.) ; goto end line;
i0:<:<10>s-break:<0>:> ;
i2: e25
i3: e32
i4: g30 ;
i5:e90
i6: e89 ;
e.
z. ; end
b. i20, j20 w.
i0: 0 ; saved link
i1: 0 ; saved w3
i2: 0 ; saved w0
i3: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
j3: g19 ; end line: base illegal
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
j14: e51 ; pointer to: tail
j15: e75 ; pointer to: cur catalogbase
j16: e76 ; pointer to: max catalogbase
; procedure stack input
; stacks the input pointers and selects the given area for input
; and sets current catalogbase
;
; call: w0,w1=catalogbase, w2=name, w3=link
; exit: all regs undef
d79: ; stack input:
rs. w3 i0. ; save return;
ds. w1 i3. ; save catalog base;
jl. w3 d84. ; set s-catalog base(cur catalog base);
jl. (j3.) ;+0: base illegal;
;+2: ok
al w3 x2 ; w3=name addr;
rl. w1 j14. ; w1=tail addr;
jd 1<11+42 ; lookup entry(name,tail);
lo w0 x1+16 ; if result<>ok or tail.content,key<>0 <* i.e. text *>
se w0 0 ; then goto unknown;
jl. i11. ;
;
rl. w1 (j5.) ; w1 := work;
rl w3 x1+c58 ; w3 := stack pointer;
sn w3 x1+c72 ; if stack pointer = last stack entry then
jl. i13. ; 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 (j15.) ;
ds w1 x3+c68 ; save cur catalog base;
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
; and set cur catalog base
dl. w1 i3. ; set cur catalog base;
ds. w1 (j15.) ;
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
; and cur catalog base
;
; 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;
dl w1 x3+c68 ; restore cur catalog base
ds. w1 (j15.) ;
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 i3. ; 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.) ;
al w2 x3 ; save nameaddr;
dl. w1 (j15.) ;
;
jl. w3 d84. ; set s-catalog base(cur catalog base);
jl. (j3.) ;+0: error: base illegal;
;+2: ok:
al w3 x2 ; restore nameaddr;
jd 1<11+92; create entry lock process(area name);
se w0 0 ; if result <> ok then
jl. i12. ; goto area error;
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. i12. ; goto area error;
i10: ; return:
dl. w1 (j16.) ;
jl. w3 d84. ; set s-catalog base(max catalog base);
jl. (j3.) ;+0: base illegal;
;+2: ok
al w1 0 ; areabuf := defined;
rs. w1 (u87.) ;
rl. w1 i3. ; restore regs;
dl. w3 i1. ;
jl x2 ; return;
i12: am j2.-j1. ;error return: area error
i11: am j1.-j0. ; : area unknown
i13: am j0.-j0. ; : not allowed
rl. w2 j0. ;
rl. w1 (j5.) ; stackpointer := stackbase;
al w0 x1+c73 ;
rs w0 x1+c58 ;
dl. w1 (j16.) ;
jl. w3 d84. ; set s-catalog base(max catalog base);
am 0 ;+0: base illegal, ignore;
jl x2 ; return
e. ;
; procedure set s-catalog base(new base)
; call return, ok: link+2, error: link
; w0: lower limit lower limit
; w1: upper limit upper limit
; w2: - unchange
; w3: link link
;
b. i5 w.
i0: 0 ; process name = 0
i1: 0 ; save w2
i2: 0 ; save w3
d84: ; begin
ds. w3 i2. ;
al. w3 i0. ; name = 0;
jd 1<11+72 ; set catalog base(name, lower, upper);
dl. w3 i2. ;
sn w0 0 ; if result=ok then
am +2 ; goto link+2
jl x3 ; else goto link;
; end;
e.
; procedure next char(char,type)
; comment: unpacks and classifies the next character from
; the console buffer:
; character type:
; 0 <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 destroyed
b.i24 ; begin
w.d1: rs.w3 i5. ; save link;
i2: dl. w2 (u28.) ;
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;
rl. w3 (u26.) ;
sh w2 x3 ; if char addr > last addr then
jl. i0. ; begin
al w0 10 ; char := newline;
rl. w1 (u24.) ;
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. i2. ; 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 (u28.) ;
i1: ; classify char:
rl w1 0 ;
ls w1 -2 ;
wa. w1 (u5.) ;
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);
rs. w0 (u109.) ; save last read char;
jl. (i5.) ; end;
i3:8.177 ;
i4:8.7 ;
i5: 0 ;
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,j10 ; begin
w.d2: rs. w3 (u60.) ;
ds. w2 (u59.) ;
rl. w1 (u87.) ;
se w1 0 ; if area buf undefined then
jl. w2 d81. ; get segment;
al w1 0 ;
rs. w1 (u87.) ; areabuf := defined;
al w0 0 ; param type := 0;
ds. w1 (u19.) ; char_count:=0;
ds. w1 (u21.) ;
ds. w1 (u23.) ; name:=0
rs. w0 i5. ; char_count:=0;
al w0 10 ;
rl. w1 ( u6.) ; radix:=10;
ds. w1 (u57.) ; state:=param table;
d3: jl. w3 d1. ; continue:
wa. w1 (u57.) ; 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 ( u6.) ; state:=
rs. w2 (u57.) ; param table+8*entry(10:11);
jl. x1 +d2. ; goto action;
d4: rl. w3 (u19.) ; letter:
jl. w1 j5. ; insert_next_char(letter);
rl. w3 (u19.) ;
al w3 x3 +1 ;
al w2 1 ; char_count:=char_count+1;
ds. w3 (u19.) ; param type:=1;
jl. d3. ; goto continue;
d5: se w0 45 ; radix or minus
jl. j1. ; if minus then
al w3 -1 ;
rs. w3 i4. ;
jl. d3. ;
j1: al w3 0 ;
rx. w3 (u19.) ; radix:=integer;
rs. w3 (u56.) ; integer:=0;
jl. d3. ; goto continue;
d6: rl. w3 (u19.) ; digit:
wm. w3 (u56.) ;
al w3 x3 -48 ; integer:=
wa w3 0 ; integer*radix-48+char;
al w2 2 ; param type:=2;
ds. w3 (u19.) ;
;
rl. w3 i5. ;
jl. w1 j5. ; insert_next_char(digit);
rl. w3 i5. ;
al w3 x3+1 ;
rs. w3 i5. ; char_count:=char_count+1;
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;
d13: ; alfa_num:
rl. w3 i5. ;
rs. w3 (u19.) ; char_count.letter:=char_count.digit;
jl. w3 d4. ; goto letter;
d7: ; unknown:
sn w0 25 ; if char = em then
jl. w2 d80. ; unstack input;
al w2 3 ;
rs. w2 (u18.) ; param type:=3;
d8: rl. w0 (u18.) ; delimiter:
rl. w2 (u18.) ;
se w2 2 ;
jl. j2. ;
rl. w3 i4. ;
sl w3 0 ;
jl. j3. ;
rl. w3 (u19.) ;
ac w3 x3 ;
j3: sh w3 -1 ;
rs. w3 (u19.) ;
rs. w2 i4. ;
j2: dl. w2 (u59.) ;
rl. w3 (u60.) ;
jl x3 ; return;
i0:3 ;
i4:0 ; sign
i5:0 ; char_count;
;
j5: ; procedure insert_next_char(char);
; begin
sl w3 11 ; if char_count>=10
jl. d7. ; then goto unknown;
al w2 0 ;
wd. w3 i0. ;
ls w2 3 ; char:=char shift
ac w2 x2 -16 ; (16-char_count mod 3 * 8);
ls w0 x2 +0 ;
ls w3 1 ; addr:=name+char_count/3*2;
am. (u20.) ;
lo w0 x3+0 ;
am. (u20.) ;
rs w0 x3+0 ; word(addr):=word(addr) or char;
jl x1 ; end;
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. (i2.) ; then goto end line;
jl. (i0.) ;
i0:0 ; end
i2: g2
; 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. (i2.) ; then goto end line;
rl. w0 (u19.) ;
jl. (i0.) ;
e. ; end
; procedure increase access(console)
; comment sets the access counter of a given console.
;
; call return
; w0: unchanged
; w1: console console
; w2: unchanged
; w3: link link
;
b. i24 w.
d9: ; begin
rs. w0 i0. ;
al w0 1 ; console.access count:=1;
rs w0 x1+c28 ;
rl. w0 i0. ;
jl x3 ; end;
; procedure decrease access(console);
; comment resets the access counter of a given console.
;
; call return
; w0: unchanged
; w1: console console
; w2: unchanged
; w3: link link
;
d10: ; begin
rs. w0 i0. ;
al w0 0 ;
rs w0 x1+c28 ; console.access count:=0;
rl. w0 i0. ;
jl x3 ; end;
i0: 0 ; common work variables for register save
i1: 0 ; in increase and decrease access.
; 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 change write mode(mode, start, top)
; note: this is only used from cat-init part of s.
; mode = 0: writing to terminal buffer
; = 1: writing to memory buffer
; if mode = 1 the writeaddress and lineaddress is changed to the specified
; buffer and the mode indication is set accordingly.
; if mode = 0 the mode switch is set to terminal (normal) and init write is
; called. the start,stop parameters are not used.
;
; procedure init write
; prepares the writing of characters in the line buffer within the current
; work area. this is not done if the mode switch = 1 i.e. memory buffer.
;
; change write mode init write
; call return call return
; w0 mode mode - unchanged
; w1 top addr destroyed - unchanged
; w2 start addr destroyed - unchanged
; w3 link link link link
;
b. i10, j10 w.
d12: rs. w0 (u53.) ; procedure change write mode;
sn w0 0 ; begin
jl. d19. ; write mode := mode;
jl. j1. ; if mode = 1 then goto init pointers
; else goto init write;
;
d19: ; entry point: init write:
ds. w2 i2. ;
rl. w1 (u53.) ; if write mode <> 0 then
se w1 0 ; return;
jl. j2. ;
rl. w2 (u24.) ; start := work.writebuf.start;
al w2 x2+c65 ; top := work.writebuf.top;
al w1 x2+c66-c65 ;
j1: rs. w2 (u45.) ; init pointers:
rs. w2 (u46.) ; write start := start;
rs. w1 (u42.) ; line start := start;
al w2 16 ; write top := top;
rs. w2 (u55.) ; write shift := 16;
;
j2: dl. w2 i2. ; return:
jl x3 ;
;
0 ;
i2: 0 ;
e. ; end;
; procedure writechar(char)
; comment: packs the next character in the storage address
; initialized by initwrite.
; if a write is attempted beyond the actual write buffer (terminal- or
; memory-buffer), nothing is written but normal return is used.
; call: return:
; w0 char destroyed
; w1 unchanged
; w2 unchanged
; w3 link link
b.i24 ; begin
w.
d20: rs. w3 i3. ;
rl. w3 (u42.) ; get writebuf.top;
rx. w1 (u55.) ; if writeshift < 0 then
rx. w2 (u46.) ; then
sl w1 0 ; begin
jl. i0. ; writeshift:=16;
al w1 16 ; writeaddr:=writeaddr+2;
al w2 x2 +2 ; end;
i0: sl w2 x3+ 0 ; if writeaddr >= writebuf.top then return;
jl. i1. ;
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;
i1: rx. w1 (u55.) ;
rx. w2 (u46.) ;
jl. (i3.) ; return;
;
i3: 0 ; saved return;
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 (u60.) ;
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 (u58.) ;
jl. w3 d20. ; write char(ch);
rl. w3 (u58.) ;
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 (u58.) ;
i7: dl. w3 (u60.) ;
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 (u60.) ; 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 writebits(integer);
; comment: moves the specified integer to the storage address initialized
; by initwrite. it is moved as a string of 24 bits (ones and points).
;
; call return
; w0 - destroyed
; w1 integer integer
; w2 - unchanged
; w3 link destroyed
;
b. i5, j5 w.
d14: ; writebits
ds. w2 i2. ; begin
rs. w3 i3. ;
al w2 -1 ;
j1: sl w1 0 ; for i:= 1 step 1 until 24 do
am 46-49 ; writechar( if integer(i) = 1 then '1'
al w0 49 ; else '.' );
jl. w3 d20. ;
ld w2 1 ;
se w2 0 ;
jl. j1. ;
dl. w2 i2. ;
jl. (i3.) ;
;
0 ;
i2: 0 ;
i3: 0 ;
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:
rl. w1 u44. ; mess := output message;
d26: ; send buf:
rs. w3 (u60.) ;
rl. w2 (u25.) ;
dl w0 x2+c75+2 ;
ds. w0 (u41.) ;
dl w0 x2+c75+6 ;
ds. w0 (u43.) ; receiver:=name(proc);
rl. w3 u40. ;
zl w0 x1+0 ;
se w0 5 ; if op=output then
jl. i2. ; begin
jd 1<11+4 ; process_description(name,curr.pda);
se w0 0 ; if no process then
jl. i2. ; begin
am (b4) ;
rl w2 a199<1 ; pda:=main_cosole.pda
dl w0 x2+a11+2 ;
ds. w0 (u41.) ;
dl w0 x2+a11+6 ;
ds. w0 (u43.) ;
rl. w3 u40. ;
; end;
; end;
i2: jd 1<11+16 ; send mess(receiver,typemess,buf);
rl. w3 (u60.) ;
jl x3 ;
e. ; end
; procedure find or select console_1(name_address, console buf);
; comment: search for a console buffer which has been used with the given
; device name. if not found a new is selected and this will be cleared and
; the name and device address are inserted.
;
; procedure find or select console_2(name address, console buf);
; comment: search for a console buffer which has been used with the given
; device name. if not found a new is selected and this will be cleared and
; the name is inserted.
;
; procedure find console(name address, console buf);
; comment: search for a console buffer which has been used with the given
; device name.
; name address may be an address of an external process or a core tabel element
; address (+c18).
;
; return: link + 0: not found and no free selected
; link + 2: found
; call return
; w0: device address device address
; w1: console buffer (error: destroyed)
; w2: unchanged
; w3: link link
b. i24, j24 w.
d64: am 2 ; find and select console_2;
d44: am 2 ; find console;
d24: al w1 0 ; find and select console_1;
rs. w1 i4. ; begin
ds. w3 i3. ;
rl. w1 (u9.) ; console := first console;
rl w2 0 ;
j0: dl w0 x2+a11+2 ; begin
sn w3 (x1+c75+0) ;
se w0 (x1+c75+2) ; if device.name = consolebuf.terminalname then
jl. j1. ; goto found;
dl w0 x2+a11+6 ;
sn w3 (x1+c75+4) ;
se w0 (x1+c75+6) ;
jl. j1. ;
jl. j4. ;
;
j1: al w1 x1+c1 ; increment:
rl. w3 (u10.) ; if console<=last console then
sh w1 x3 ;
jl. j0. ; goto next;
; end;
rl. w0 i4. ;
sn w0 2 ; if not find_and_select_console then
jl. j5. ; return;
; else
; begin <* select a free *>
rl. w1 u35. ; console := free list.first;
rl w1 x1+c20 ;
sn. w1 (u35.) ; if console = none then
jl. j5. ; goto error-return;
;
al w0 0 ; <* clear the free console buffer *>
al w3 c29 ;
j3: am x3 ; for field := namefield, next until
rs w0 x1+0 ; userinterval-field do
al w3 x3+2 ; console.field := 0;
sh w3 c43+2 ;
jl. j3. ;
; end;
dl w0 x2+a11+2 ; found:
ds w0 x1+c75+2 ;
dl w0 x2+a11+6 ; consolebuf.terminalname := terminal name;
ds w0 x1+c75+6 ;
j4: rl. w0 i4. ;
sn w0 0 ; if find_and_select_console_1 then
rs w2 x1+c25 ; consolebuf.console description := terminal address;
al w0 x2 ;
dl. w3 i3. ;
jl x3+2 ; return ok;
;
j5: ; return not ok: <* no free console buffer or not found*>
dl. w3 i3. ;
jl x3+0 ;
;
0 ; save w2
i3: 0 ; save w3
i4: 0 ; branch address
e.
; 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 (u30.) ; entry first hole:
rl. w0 (u16.) ; hole addr:= first core;
rl. w3 u15. ; element:= core table head;
jl. j2. ; goto advance;
j1: rx. w3 (u30.) ; entry next hole:
se. w3 (u15.) ; element := core table element;
jl. j3. ;
rl. w3 (u30.) ; if element = core table head then
jl x3 ; return sorry;
j3: am (x3+c17) ; ;
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 (u15.) ; if element = core table head
rl. w1 u1. ; el then tophole=topcore
rs. w2 i5.
rl w2 x1+a182
rl w1 x1+a17 ; else tophole:= first addr(child(element));
se. w3 (u15.) ;
wa w1 4 ; add base
ws w1 0 ; hole size:= top hole - hole addr;
rx. w3 (u30.) ; core table element:= element;
rl. w2 i5. ;
jl x3 +2 ; return happy;
i5: 0
; procedure find parent(child,terminal.pda,coretableelement,sorry);
; comment: searches the parent console of a given child and
; sets the variable core table element.
; if the child is found, the console name is checked, if the process does not exist
; the main console is selected, or if the process has got a new process description addr this is used
; call: return:
; w0: destroyed
; w1: terminal
; w2: child child
; w3: link core table element
d25: rs. w3 (u60.) ; begin
am j0-j1 ; for i:= first hole,
i0: jl. w3 j1. ; next hole while happy do
jl. i6. ; begin
rl. w3 (u30.) ; if child = child(element) then
se w2 (x3+c17) ; exit
jl. i0. ; end;
rl w1 x3+c18 ;
al w3 x3+c106 ;
jd 1<11+4 ; process_description(name,found.pda);
se w0 0 ; if no process then
rl w1 0 ; terminal.pda:=old.pda else terminal.pda:=found.pda
rl. w3 (u30.) ; restore core table element;
rs w1 x3+c18 ;
am +2 ; ok return;
i6: al w0 0 ; return sorry:
wa. w0 (u60.) ;
jl (0) ; 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 (u37.) ; begin
rs. w3 (u38.) ; 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. i7. ; goto found;
rl. w3 (u37.) ; goto return sorry;
sl w1 x3 ;
jl. 4 ; found: size:= wanted size;
jl. i1. ; first addr:= hole addr;
dl. w2 (u38.) ; return happy;
jl x2 +2 ;
i7: dl. w2 (u38.) ; return sorry:
jl x2 ; 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 (u57.) ; begin
rs. w3 (u58.) ;
rl w2 0 ;
am j0-j1 ; for size:= first hole, next hole while happy do
i2: jl. w3 j1. ; begin
jl. i8. ; if holeaddr > start addr then
sl w0 x2 +2 ; return sorry;
jl. i8. ; add := hole addr + hole size
wa w1 0 ; - wanted size;
ws. w1 (u57.) ; if add >= start then goto found;
sh w1 x2 -2 ; end;
jl. i2. ; return sorry;
al w0 x2 ; found:
dl. w2 (u58.) ; return happy;
jl x2 +2 ;
i8: dl. w2 (u58.) ; return sorry;
jl x2 ; 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 (u58.) ; 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
c.(:a399>22a.1:)-1
rl. w3 (u82.) ;
sl w1 x3 ; if max > max r.size then
al w1 x3 ; max:= max r.size;
z.
rl. w3 (u58.) ;
jl x3 ; 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 (u60.) ; i:= base core table;
rl. w1 (u33.) ; 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;
rs. w2 i5. ; save console;
rl. w2 (u30.) ; link element(coretable entry(i));
jl. w3 d18. ; core table element);
al w2 x1 ; core table element:= core table entry(i);
rs. w1 (u30.) ; core table element. child:= child;
rl. w1 i5. ;
rl w1 x1+c25 ;
ds w1 x2+c18 ; core table element. console:= console;
rl. w1 i5. ;
rl. w3 (u79.) ;
rs w3 x2+c22 ; coretable element. segm:=segmentno
al w3 -1 ;
rs. w3 (u79.) ;
rl w0 x2+c17 ;
rl. w3 (u60.) ; return;
jl x3 ;
i5: 0 ; saved console
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 (u30.) ;
al w2 -1 ;
rs w2 x1 c22 ;
rl. w1 (u30.) ;
jl. w3 d17. ; release element (core table element);
jl. (i1.) ; return
i1:0
e. ; end
; 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 (u29.) ;
dl w1 x2+a11+2 ;
ds. w1 (u41.) ;
dl w1 x2+a11+6 ; receiver:=name(child);
ds. w1 (u43.) ;
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 terminal from which
; the child was created.
; call: return:
; w0 destroyed
; w1 console (if result ok)
; w2 child "
; w3 link destroyed
b.i24,j2 ; begin
w.d34:rs. w3 i0. ;
rl. w1 (u25.) ;
al w3 x1+c29 ; process description(
jd 1<11+4 ; process name(console),result);
rs. w0 (u29.) ; child:=result;
rl w2 0 ;
rl w1 x2 +0 ;
se w2 0 ; if child=0
se w1 0 ; or kind(child)<>0
jl. (r9.) ; then goto end line;
jl. w3 d25. ;
jl. (r3.) ; find parent(child,parent,end line);
rl. w2 (u25.) ; w2:=current console
zl w0 x2+c27 ;
sz w0 1<3 ; if privileged then
jl. j0. ; ok return
dl w1 x3+c106+2 ;
sn w0 (x2+c75+0) ;
se w1 (x2+c75+2) ;
jl. (r3.) ;
dl w1 x3+c106+6 ;
sn w0 (x2+c75+4) ; if name.core table <> name.console table
se w1 (x2+c75+6) ; then
jl. (r3.) ; goto end line
j0: rl. w2 (u29.) ;
jl. (i0.) ;
i0:0 ;
e. ; end
;
; u block
; indirect addressing of e-names
;
u1: e1
u5: e5
u6: e6
u9: e9
u10: e10
u15: e15
u16: e16
u18: e18
u19: e19
u20: e20
u21: e21
u22: e22
u23: e23
u24: e24
u25: e25
u26: e26
u27: e27
u28: e28
u29: e29
u30: e30
u31: e31
u33: e33
u35: e35
u37: e37
u38: e38
u40: e40
u41: e41
u42: e42
u43: e43
u44: e44
u45: e45
u46: e46
u53: e53
u55: e55
u56: e56
u57: e57
u58: e58
u59: e59
u60: e60
u79: e79
c.(:a399>22a.1:)-1
u82: e82
z.
u87: e87
u90: e90
u109:e109
; r-block
; indirect addressing of g-names
;
r3 : g3
r4 : g4
r5 : g5
r6 : g6
r7 : g7
r8 : g8
r9 : g9
r10: g10
r11: g11
r18: g18
r19: g19
r20: g20
r25: g25
r27: g27
r101:g101
; stepping stones
;
jl. (2) , d20 , d20=k-4
jl. (2) , d22 , d22=k-4
; 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, except temp links not used
; by the child. 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.i30, j10 w. ; begin
d35:rs. w3 i2. ; find core:
rl. w2 e25. ;
rl w1 x2+c39 ; size:=size(console);
sn w1 0 ; if size = 0 then
jl. w3 d29. ; find max(size);
rl. w2 e25. ;
rl w0 x2+c30 ; start := first addr(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. (r4.) ;
rl. w2 e25. ;
rs w0 x2+c30 ; first addr(console):=start;
wa w0 2 ; top addr(console):=
rs w0 x2+c31 ; start+size;
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. (r3.) ;
al w1 -1 ; then no relocation and
rs w1 x2+c97 ;
al w0 0 ; 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. (r5.) ; 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. (r6.) ; 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. (r7.) ; 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. (r19.) ; then goto base alarm;
rl w1 x2+c43 ;
sl w1 (x2+c41) ; 3; if cons.user.lo < cons.max.lo
jl. 4 ;
jl. (r19.) ;
sh w1 (x2+c42) ;
sz ;
jl. (r19.) ; 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. (r19.) ;
al w1 x1 -2 ;
sl w1 (x3+a45-0) ; 7; if cons.max.hi > s.std.hi
jl. (r19.) ; 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. (r4.) ;
sn w0 2 ;
jl. (r11.) ;
se w0 0 ; if result<>0
jl. (r10.) ; 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+c97 ;
jl. j0. ;
rl. w2 e30. ;
dl w0 x1+c75+2 ; move name of terminal
ds w0 x2+c106+2 ; to core table
dl w0 x1+c75+6 ;
ds w0 x2+c106+6 ;
al w3 x1+c29 ;
al w2 x1 ;
rl w1 x1+c97 ; if first logic address defined then
sn w1 -1 ;
jl. j2. ; begin
rl w1 x2+c30 ; displacement := first address ( "physical")
ws w1 x2+c97 ; - first logic address
jd 1<11+98 ; change address base
sn w0 0 ; if not ok
jl. j2. ; then begin
jl. w3 d40. ; remove process
jl. (r101.) ; write illegal relocation ; end
; set the cpa register(child)
j2 : rl w1 x2+c98 ; if cpa < > initial cpa then
sn w1 1 ; begin
jl. j3. ;
sn w1 -1 ; if cpa(console) = -1 (default)
rl. w1 e16. ; then cpa(child) = top of s own area
jd 1<11+126 ; set cpa
sn w0 0 ; if not ok then
jl. j3. ; begin
jl. w3 d40. ; remove process
jl. (r8.) ; write illegal cpa
; set the priority of the process
; if the priority differs from default. (0)
j3: zl w1 x2+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. (r27.) ; goto end line
; include process as user of all peripheral devices except those listed
; in the s device exception tablr.
; process will not be included as user of temp links
; execpt the temp link for the process' console.
i19: rl. w2 e25. ;
rl w2 x2+c25 ;
rs. w2 i26. ; save child.console;
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: rs. w2 i28. ; save exception table address.
al w2 x1 ; next device := 2 * deviceno + first device;
ls w2 1 ;
wa w2 b4 ;
rl w2 x2 ; if next device.kind <> temp link or
rl w0 x2 ; (next device.kind = temp link and
sn w0 85 ; next device = child.console) then
sn. w2 (i26.) ;
jd 1<11+12 ; include user(device,name addr);
rl. w2 i28. ; restore exception table address;
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)
al. w2 e20. ;
jl. w1 d73. ; lookup bs claims(device,s)
rl. w3 e25. ;
al w3 x3+c29 ;
jd 1<11+78 ;
se w0 0 ; if result<>0
jl. (r20.) ;
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
i12:0 ;
i11:0 ; end
z. ;
jl. (r18.) ;
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;
rl. w2 r20. ; 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;
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;
rl. w2 r25. ; 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
i26: 0 ; child.console
i28: 0 ; save exception table addr.
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,terminal,coretableelement,
am 0 ; irrelevant);
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);
rs. w3 i20. ;
dl w1 x2+c43+2 ; get catbase of console.(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
zl. w1 e67. ; child ic:= first addr(child) (logical) +
wa w1 x2+a17 ; ic(tail)
rs. w1 e66. ;
sl w1 (x2+a18) ; if ic > top addr(child) then
jl. i13. ; give up
rl w1 x2+a18 ; save physical top(child)
wa w1 x2+a182 ;
al w2 x1 ;
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;
sl w1 x2 ; 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);
al. w1 e47. ; load program:
jd 1<11+16 ; send mess(receiver,area mess,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
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 ;
al. w3 i1. ; (prevent remove process(proc)
sn w0 0 ; if not ok then
jl. i15. ; goto restore base(s)
am 2 ; base illegal
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
g19 ; +12
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);
al. w3 i10. ; wait:
al. w1 i11. ;
jd 1<11+16 ; send message(clock,wait);
al. w1 i12. ;
jd 1<11+18 ; wait answer(answer area);
jl. (i0.) ;
i0:0 ;
i10: <:clock:>,0,0,0 ; clock-name and name table entry
i11: 0<12 ; delay message
1 ; time (in seconds)
i12: 0,r.8 ; answer area
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.
; return: link + 0: not found
; link + 2: found
; 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+2 ; return ok;
al w1 x1+c2 ; increase(work);
sh. w1 (e14.) ; if work <= last work then
jl. i0. ; goto loop;
jl x3 ; return sorry
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;
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 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 reset last part of console
; comment sets zeroes in whole claimlist of console descr
; and in primin and primout.
; initialize first logic address to standart value.
;
; call: w3 = link
; exit: all regs undef
b. i10 w.
d46: ; clear claimlist:
rl. w1 e25. ; w1 := console;
al w2 x1+c48-c49+2; w2 := rel top of area to be cleared;
al w0 0 ;
i0: ; rep:
sl w1 x2 ; if pointer <= start of console then
jl. i1.
al w2 x2-2 ; decrease pointer
rs w0 x2+c49 ; claimlist(pointer) := 0;
jl. i0. ; goto rep;
i1: rl. w0 e72. ; set first logic address
rs w0 x1+c97 ; and cpa
al w0 -1 ; return
rs w0 x1+c98 ;
jl x3 ;
e.
; procedure release temp link(console addr);
; comment if the console is a temp link it will be removed.
; (if s is the only user 'remove process' will remove the link.)
;
; call return
; link+2: ok link: error
; w0: destroyed
; w1: destroyed
; w2: console addr console addr
; w3: link link
;
b. i10 w.
d48: ; begin
rl. w1 e25. ; w1:=curr console
zl w0 x1+c27 ;
sz w0 1<3 ; if privileged console then
jl x3 ; return
rl w1 x2+ a10 ; if console.kind<>temp link
se w1 85 ;
sn w1 q8 ; or console.kind<>csp terminal then
sz ;
jl x3 ; error return;
rs. w3 i3. ;
dl w1 x2+a11+2 ; <* get and move name of link *>
ds. w1 i1. ;
dl w1 x2+a11+6 ;
ds. w1 i2. ;
al. w3 i0. ;
jd 1<11+64 ; remove process(temp link);
rl. w3 i3. ; if result = ok then
sn w0 0 ;
am +2 ; ok return
jl x3 ; else error return;
;
i0: 0 ; name area
i1: 0,0 ;
i2: 0 ;
i3: 0 ; save link
e.
c. (:a80>16a.1:)-1 ; if itc included
b. m0 , n2 w. ; block including procedures used by itc controller commands
m0: 0,0,0,0,0 ; save name area + name table address
; procedure connect(name address, param address, devno, log status);
;
; procedure initalize_main(name address,buffers,log status);
;
; a connect operation (specified by the parameters) is send to the
; itc main process specified by name. if the connection is made the
; rc8000 devno is returned else logical status is returned.
; format of the param area must be:
;
; connect initialize
; + 0: control module or formatter number max buffs
; + 2: disc unit or station number
; + 4: wanted rc8000 devno of connection or
; -1 if no specific devno is wanted
; + 6: device kind, device type
;
; call return
; connect initialize
; w0 - logical status
; w1 name address name address destroyed
; w2 param address buffers devno
; w3 link link destroyed
;
; return: link + 0: error (devno not valid)
; link + 2: ok
;
b. i5, j5 w.
d59: am 16 ; procedure inittialize_main
d51: al w0 6 ; procedure connect
rs. w0 i0. ;
rs. w3 e83. ; begin
dl w0 x1+2 ; <* save return in stack part of work area *>
ds. w0 m0.+2 ; <* move name to name area *>
dl w0 x1+6 ;
ds. w0 m0.+6 ;
al. w1 e32. ; <* move parameters to message area *>
rl. w0 i0. ; message.operation := connect/initialize;
hs w0 x1+0 ;
se w0 6 ; if connect then
jl. j2. ; begin
al w0 1 ; message.mode := include all users;
hs w0 x1+1 ;
dl w0 x2+2 ; message.cm := param.cm;
ds w0 x1+4 ; message.unit := param.unit;
dl w0 x2+6 ; message.devno:= param.devno;
ds w0 x1+8 ; message.devkind, type := param.devkind, type;
rl w0 x2+8 ;
rs w0 x1+10 ; message.count:=max buffer
jl. j3. ; end else
j2: rs w2 x1+2 ; message.buffs:=param.buffres;
j3: al. w3 m0. ;
jd 1<11+16 ; send message(connect message, itcmain);
jl. w3 d42. ; save work;
jl. j1. ; +0: error: goto error;
; +2: ok:
j0: rl. w2 e52. ; devno := answer.devno;
am. (e83.) ;
jl +2 ; ok-return;
;
j1: sz w0 2.111101 ; error:
jl. (e83.) ; if not result-error then
rl w1 0 ; begin
ls w1 -8 ; if status.result = 0 then
sz w1 2.111111 ; goto ok-return
jl. (e83.) ; else error-return;
al w0 1<1 ; <it is assumed that status.result=0 =>
jl. j0. ; device description=1!>
; end else error-return;
i0: 0 ; link kind;
e. ; end;
; procedure disconnect(device number);
;
; a disconnect operation is send to the itc main process which is
; supervisor for the specified device.
;
; call return
; w0 device number logical status
; w1 - destroyed
; w2 - destroyed
; w3 link destroyed
;
; return: link + 0: error - w0 contains logical status.
; link + 2: ok - w0 is undefined.
;
b. i5, j5 w.
d52: ; disconnect
rs. w3 e83. ; begin
al. w1 e32. ;
rs w0 x1+2 ; message.rc8000 devno := device number;
al w2 10 ;
ls w2 +12 ; message.operation, mode :=
rs w2 x1+0 ; disconnect, 0;
rl w1 0 ;
jl. w3 d56. ; check device(devno);
jl. j3. ; +0: error: goto simulate result 3;
al w2 x2+a11 ; +2: ok:
al. w3 e20. ;
jl. w1 n2. ; move name(itcmain.name, name area);
;
al. w1 e32. ;
jd 1<11+16 ; send message(disconnect mess, itcmain.name);
jl. w3 d42. ; save work(buffer);
jl. j4. ; +0: error:
; +2: ok:
j0: am. (e83.) ; ok-return;
jl +2 ;
; else
; error-return:
j3: al w0 1<3 ; simulate result 3;
j4: jl. (e83.) ; error return;
;
e. ; end;
; procedure link(param,devno,logical status);
;
; a link operation is send to the ida main process which supervice the
; physical disc stated in the param area.
;
; call return
; w0: - logical status
; w1: - destroyed
; w2: param address device no of logical disc
; w3: link destroyed
;
; return: link + 0: error: result or status error
; link + 2: ok: w2 contains device number of logical disc
;
; format of param area:
; +0: devno of logical disc or -1
; +2: devno of physical disc
; +4: first segment
; +6: no of segments
;
b. i5, j5 w.
d53: ; procedure link
rs. w3 i3. ; begin
al. w1 e32. ;
dl w0 x2+2 ; <*.move param to message area *>
ds w0 x1+4 ;
dl w0 x2+6 ;
ds w0 x1+8 ;
al w0 16 ; message.operation, mode :=
ls w0 +12 ; link logical disc, include all users;
ba. w0 1 ;
rs w0 x1+0 ;
;
rl w1 x1+4 ;
jl. w3 d56. ; check device(devno);
jl. j3. ; +0: error: goto simulate result 3;
; +2: ok:
al w2 x2+a11 ;
al. w3 m0. ;
jl. w1 n2. ; move name(idamain, name area);
al. w1 e32. ;
jd 1<11+16 ; send message(link message, idamain.name);
al. w1 e51. ;
jd 1<11+18 ; wait answer(answer, result);
jl. j1. ;
;
j3: al w0 3 ; simulate result 3:
sz ;
j1: ; return:
rl. w2 e52. ; devno of link := answer.devno of logical disc;
rl. w3 i3. ;
jl. n1. ; compute logical status and return;
;
i3: 0 ; link
;
e. ; end;
; procedure unlink(devno);
;
; a unlink logical disc operation is send to the ida main process which
; supervise the stated logical disc.
;
; call return
; w0 devno of log disc logical status
; w1 - logical status
; w2 - destroyed
; w3 link destroyed
;
; return: link + 0: error
; link + 2: ok
;
b. i5, j5 w.
d54: ; procedure unlink
rs. w3 i3. ; begin
al. w3 e32. ;
rs w0 x3+2 ; message.devno := devno;
al w1 18 ;
ls w1 +12 ; message.operation, mode :=
rs w1 x3+0 ; unlink, 0;
rl w1 0 ;
jl. w3 d56. ; check device(devno);
jl. j3. ; +0: error: goto simulate result 3;
se w0 6 ; +2: ok
jl. j3. ; if device.kind <> idadisc then
; goto simulate result 3;
al w2 x2+a11 ;
al. w3 e20. ; move name(idamain, name area);
jl. w1 n2. ;
al. w1 e32. ;
jd 1<11+16 ; send message(unlink mess, idamain.name);
;
al. w1 e51. ;
jd 1<11+18 ; wait answer(answer, result);
jl. j1. ;
; return answer:
j3: al w0 3 ; simulate result 3:
j1: rl. w3 i3. ; return:
jl. n1. ; compute logical status and return;
;
i3: 0 ; saved link
;
e. ; end;
; procedure read segment(segment, devno);
; procedure write segment(segment, devno);
;
; the specified segment is input to the disc description buffer or the
; buffer is output to the disc with the specified device no.
;
; call return
; w0 segment logical status
; w1 devno logical status
; w2 - destroyed
; w3 link destroyed
;
; return: link + 0: disc error
; link + 2: ok
;
b. i10, j10 w.
d55: am -2 ; read segment
d57: al w2 5 ; write segment
ls w2 +12 ; begin
rs. w3 i3. ;
rs. w3 i4. ; wrkname := undefined;
rs. w1 i1. ;
al. w3 e32. ;
rs w2 x3+0 ; message.operation := read or write;
rs w0 x3+6 ; message.segment := segment;
dl. w1 i5. ; message.first add := buffer.first;
ds w1 x3+4 ; message.last add := buffer.last;
rl. w1 i1. ;
;
jl. w3 d56. ; check device(devno, device);
jl. j4. ; +0: if error then goto error return;
; +2:
al w2 x1+a11 ;
al. w3 m0. ;
jl. w1 n2. ; move name(device.name, name save area);
;
j1: al. w1 e32. ; reserve and send:
zl w0 x1+0 ; if operation = output then
sn w0 5 ; reserve process(disc name);
jd 1<11+8 ;
jd 1<11+16 ; send message(messagearea, device);
al. w1 e51. ;
jd 1<11+18 ; wait answer(message, answer);
se w0 5 ; if result <> 5 then
jl. j2. ; return;
; < result = 5 i.e. unknown >
al w0 0 ;
rs w0 x3+0 ; name(0) := 0;
rl. w1 i1. ;
jd 1<11+54 ; create peripheral process(name, devno);
se w0 0 ; if result <> ok then
jl. j2. ; return;
rs. w0 i4. ; wrkname := defined;
jl. j1. ; goto send;
;
j4: al w0 3 ; simulate result 3:
jl. j3. ;
j2: ; return:
rl w2 0 ; <save result>
jd 1<11+10 ; release process(disc);
rl. w1 i4. ; if wrkname = defined then
sn w1 0 ; remove process(disc);
jd 1<11+64 ;
al w0 x2 ;
j3: rl. w3 i3. ;
jl. n1. ; compute logical status and return;
;
i1: 0 ; devno
i3: 0 ; link
i4: 0 ; wrkname defined (0=defined)
h23 ; disc description buffer: first
i5: h24 ; --- " --- : last
;
e. ; end;
; procedure check device(devno);
;
; checks that the specified devno is legal and that the device is an
; idadisc, ida mag tape or ifp gsd device.
; the process description addresses of the device and the itc main process
; for the device is returned.
;
; call return
; w0 - kind of device
; w1 devno proc addr of device
; w2 - proc addr of itcmain of device
; w3 link type of device
;
; return: link + 0: not an itcdevice
; link + 2: ok
;
b. i5, j5 w.
d56: ; procedure check device
rs. w3 i3. ; begin
ls w1 +1 ;
wa w1 b4 ; device := nametable(devno);
sl w1 (b4) ; if not device = external then
sl w1 (b5) ; error-return;
jl x3 ;
rl w1 x1 ;
rl w0 x1+a10 ; if device.kind <> idadisc and
se w0 6 ; device.kind <> idamt and
sn w0 18 ; device.kind <> ifpgsd and
jl. j1. ; ;
se w0 28 ;
sn w0 8 ; device.kind <> csp_terminal then
jl. j1. ; error return;
jl x3 ; error return;
j1: ;
rl w2 x1+a50 ; itcmain := device.main.main;
rl w2 x2+a50 ; < second load only needed for an ida logical disc >
zl w3 x1+a57 ; type := device.type;
am. (i3.) ;
jl +2 ; ok-return;
;
i3: 0 ; saved link
;
e. ; end;
c.(:a399>21a.1:)-1
; procedure prepare dump(pda of external_proc/area_proc,address_buff);
; a prepare dump is sent to the mainprocess associated with the ext/area proc
;
; reg call return
; w0 - undef
; w1 pda -
; w2 address buff -
; w3 link -
; return: link+0: not ok
; link+2 ok
b. i5,j5 w.
d58: ds. w2 i2. ;
rs. w3 i3. ;
al. w3 m0. ;
al w2 x1+a11 ;
jl. w1 n2. ; move_name(proc.name,name save area);
jd 1<11+8 ; reserve process
se w0 0 ; if reserve ok then
jl. j2. ; begin
rl. w1 i1. ;
j0: rl w1 x1+a50 ;
rl w0 x1+a10 ;
sn w0 q6 ; while kind=disc kind do
jl. j0. ; goto inspect next
se w0 q20 ; if kind=ida kind then
jl. j2. ; begin
al. w3 m0. ;
al w2 x1 ;
jl. w1 n2. ; move_name(proc.name,name save area);
rl. w2 e106. ;
se w2 0 ; if pp_buff sent then
jd 1<11+82; regret message
al. w1 e32. ;
rl. w2 i2. ;
dl w0 x2+2 ;
ds w0 x1+4 ; mess.low:=addres_buff.low
dl w0 x2+6 ;
ds w0 x1+8 ; mess.high:=address_buff.high
rl. w0 i1. ;
rs w0 x1+10 ; mess.pda:=ext_proc/area_proc
al w0 2 ;
hs w0 x1+0 ; mess.op:=prepare dump
jd 1<11+16; send message
rs. w2 e106. ; pp_buff:=buffer addresss
am 2 ; return ok
j2: al w0 0 ; return not ok
jd 1<11+10; release process
rl. w3 i3. ; end;
am (0) ;
jl x3 ; end;
i1: 0 ; saved w1
i2: 0 ; - w2
i3: 0 ; - w3
e.
z.
c.-(:a399>21a.1:)
d58: jl x3 ;
z.
; procedure compute logical status and return(result, error return address)
;
; the logical status is created. if it signals ok status return is made to
; error return + 2 else return is made to error return address.
; it is assumed that e51 contains status.
;
; call return is made with
; w0 result logical status
; w1 - logical status
; w2 - unchanged
; w3 error link destroyed
;
n1: ; compute logical status and return
al w1 1 ; begin
ls w1 (0) ; logical status := if result error then
sn w1 1<1 ; set result error
lo. w1 e51. ; else set status error;
al w0 x1 ;
sn w0 1<1 ; if logical status = ok then
am +2 ; return ok
jl x3 ; else return error;
; end;
; procedure move name(name address, destination address);
;
; call return
; w0 - unchanged
; w1 link destroyed
; w2 name address name address
; w3 destination destination
;
b. i5, j5 w.
n2: ; procedure move name
ds. w1 i1. ; begin
dl w1 x2+2 ; move the name;
ds w1 x3+2 ;
dl w1 x2+6 ;
ds w1 x3+6 ;
rl. w0 i0. ;
jl. (i1.) ;
;
i0: 0 ;
i1: 0 ;
e. ; end;
e. ; end of block for itc controller commands
z.
c.-(:a80>16a.1:) ; if itc not included then insert dummy procedures
d51: ;
d52: ;
d53: ;
d54: ;
d55: ;
d56: ;
d57: ;
d58: ;
d59: ;
jl x3 ;
;
z. ; end itc not included;
; 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.
; procedure lookup bs claims(device,process);
; comment the bs-claims for the process is looked up on the given device;
; call: return:
;w0 - result
;w1 return addr. of bs-claims
;w2 device unchanged
;w3 process -
b. i2 w.
d73: al. w3 i2. ; entry0: w3:=addr('s');
d74: rs. w1 i0. ; entry2: store(w1);
rl. w1 i1. ; w1:= addr(bs claim store);
jd 1<11+118 ; lookup bs-claims
jl. (i0.) ; return;
i0: 0 ;
i1: e86 ; addr of bs claims
i2: <:s:>,0,0,0 ; current process
e.
; 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,i10=(:d13-d2:)<2+1
h.h1:
; initial state:
i3, i5, i4, i0 ; letter 1, digit 2, unknown 0, continue 0
i6, i9, i6, i0 ; unknown 0, endline 0, 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 0, unknown 0, continue 1
; after digit:
i10, i5, i4, i7 ; alfa num 0, digit 2, radix 2, delimit 0
i7, i9, i6, i2 ; delimit 0, endline 0, unknown 0, continue 2
e.
;
; assignment of d-names to l-names used in all following stepping stone blocks
;
l0 = d0, l1 = d1, l2 = d2, l3 = d3, l4 = d4, l5 = d5
l6 = d6, l7 = d7, l8 = d8, l9 = d9, l10 = d10, l11 = d11
l12 = d12
l14 = d14, l15 = d15, l16 = d16, l17 = d17, l18 = d18, l19 = d19
l20 = d20, l21 = d21, l22 = d22, l23 = d23, l24 = d24, l25 = d25
l26 = d26, l27 = d27, l28 = d28, l29 = d29, l30 = d30, l31 = d31
l33 = d33, l34 = d34, l35 = d35, l36 = d36, l37 = d37
l38 = d38, l39 = d39, l40 = d40, l41 = d41, l42 = d42, l43 = d43
l44 = d44, l45 = d45, l46 = d46, l48 = d48, l51 = d51, l52 = d52
l53 = d53, l54 = d54, l55 = d55, l56 = d56, l57 = d57, l58 = d58
l59 = d59, l61 = d61, l64 = d64, l70 = d70, l71 = d71, l73 = d73
l74 = d74, l77 = d77, l78 = d78, l79 = d79, l80 = d80, l81 = d81
l82 = d82, l83 = d83, l84 = d84
;
; stepping stones
;
jl. (2) , l2 , d2 = k-4
jl. (2) , l9 , d9 = k-4
jl. (2) , l10 , d10 = k-4
jl. (2) , l12 , d12 = k-4
jl. (2) , l14 , d14 = k-4
jl. (2) , l15 , d15 = k-4
jl. (2) , l16 , d16 = k-4
jl. (2) , l17 , d17 = k-4
jl. (2) , l18 , d18 = k-4
jl. (2) , l19 , d19 = k-4
jl. (2) , l20 , d20 = k-4
jl. (2) , l21 , d21 = k-4
jl. (2) , l22 , d22 = k-4
jl. (2) , l23 , d23 = k-4
jl. (2) , l24 , d24 = k-4
jl. (2) , l25 , d25 = k-4
jl. (2) , l26 , d26 = k-4
jl. (2) , l27 , d27 = k-4
jl. (2) , l29 , d29 = k-4
jl. (2) , l34 , d34 = k-4
jl. (2) , l35 , d35 = k-4
jl. (2) , l36 , d36 = k-4
jl. (2) , l37 , d37 = k-4
jl. (2) , l38 , d38 = k-4
jl. (2) , l39 , d39 = k-4
jl. (2) , l40 , d40 = k-4
jl. (2) , l41 , d41 = k-4
jl. (2) , l42 , d42 = k-4
jl. (2) , l44 , d44 = k-4
jl. (2) , l45 , d45 = k-4
jl. (2) , l46 , d46 = k-4
jl. (2) , l51 , d51 = k-4
jl. (2) , l52 , d52 = k-4
jl. (2) , l53 , d53 = k-4
jl. (2) , l54 , d54 = k-4
jl. (2) , l55 , d55 = k-4
jl. (2) , l56 , d56 = k-4
jl. (2) , l57 , d57 = k-4
jl. (2) , l58 , d58 = k-4
jl. (2) , l61 , d61 = k-4
jl. (2) , l64 , d64 = k-4
jl. (2) , l70 , d70 = k-4
jl. (2) , l71 , d71 = k-4
jl. (2) , l77 , d77 = k-4
jl. (2) , l78 , d78 = k-4
jl. (2) , l79 , d79 = k-4
jl. (2) , l80 , d80 = k-4
c69:<:susercat:>, 0, 0 ; name of s-usercat, incl. name table table entry
▶EOF◀