|
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: 115968 (0x1c500)
Types: TextFile
Names: »central«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦0b92c64d5⟧ »ctb«
└─⟦this⟧
(bos = set 8 disc
bos = slang proc.options
bos = entry bos bos 0 0 0 8.12 bos
scope user bos
print bos integer words.4 4.10
)
\f
; rc 18.2.71 contents central ...1...
; Content of central logic and use of key variables in the coroutine
; description:
;
; chain state page2 d-name page
;
; send and wait answer bufferaddr 0 d0 9
; send and wait fast answer bufferaddr coretabref d1 9
; send and wait slow answer bufferaddr coretabref d2 9
; stop and wait answer bufferaddr 0 d26 9
; lock sem 0 unch d3 10
; or pagerque semaddr unch
; open unch unch unch d4 12
; lock chained sem 0 unch d5 10
; or pagerque semaddr virt op
; open chained pagerque virt op last virtop d6 11
; getpages pagerque 0 unch d7 13
; page jump pagerque 0 unch d8 13
; put inchain d9 13
; get from chain d10 13
; put in activ chain d11 13
; wait d12 14
; exit from pager d13 14
; clear core d14 13
; alarm d15 3
; start of init d16 31
; call d17 13
; pagerbuf free d20 26
; coruno output d21 4
; entry pager d23 20
; page 0 of pager d24 20
; lock after checkpages c1 10
; open chained after checkpages c2 11
; first event c3 14
; next event c4 14
; checkpages c5 14
; exit to coruno c7 15
; answer received c8 15
; message received c9 16
; page missing c10 14
; check one page c11 17
;
;
; During open chained the chain of the operation containes the
; semaphor address;
\f
b. w.
p.<:fpnames:>
p.1
; sl 3.7.72 break central ...2...
h99 = 0 ; count k-assignments
c.e7 , k = h55 , h99 = h99 + 4 z.
s0=0, s1=1 ; clear checksums
s. d40, f70 w. ; block for central logic, pager and init
f0: 0,0 ; abs f0 (for dump), max request free
f48, f49 ; request free addr(for performon), checksums
78 08 07, 72 ; version id:
al. w3 f0. ;+12 entry from fp or s:
am. (+4) ; w3:= boss core base;
jl. +2 ; goto start of init;
d16. ;+18 words also used for saved registers;
b. c30 w. ; block for central logic
m. boss 2 central
; break routine, alarm
b. a10, b10 w. ;
b6=f0+6 ; interrupt addr;
c.e56-k+b6-1
jl. 2, r.(:e56-k+2+b6:)>1; extend register dump area to e56 bytes;
z.
al. w1 b6. ; w1:=interrupt addr;
dl. w3 b6.+12 ; w3:= cause; w2:= ic
rl. w0 b1. ;
ws w0 x2-2 ; w0:= jd-1 - instruction;
sn w3 0 ; if cause = 0
se w0 0 ; and instruction = jd-1 then
jl. a1. ; begin
al w0 14<6+8 ; w0:= 14 bytes, kind 8
rl. w2 f1. ; w2:= corutine;
bl w3 x2+4 ; if testmode 1 then
sz w3 1 ;
jl. w3 d21. ; call coruno output
dl. w1 b6.+2 ; reestablish all registers
dl. w3 b6.+6 ; return
xl. b6.+9 ;
c.-e80
jl. (b6.+10); rc4000 return
z.
c. e80
je. (b6.+10); rc8000 return
z.
a1: sh w0 199 ;
sh w0 0 ; if not jd-199 to jd-1 then
al w0 0 ; w0:= 1;
ba. w0 1 ;
se w0 1 ; left byte(w3) :=
ac w3 (0) ; if cause is jd-2 to jd-199 then
ls w3 12 ; bossfault number else interrupt cause;
rl. w2 f2. ; w2:=abs corunocode;
hl w3 x2+10 ; right byte(w3):=page ident;
rs. w3 b6.+12 ; save fault cause, page ident;
ls w2 2 ;
wa. w2 b6.+8 ;
rs. w2 b6.+8 ; save corunocode together with exception reg.
al. w2 b7. ;
a2: al w3 0 ; convert fault cause
wd. w0 b8. ;
al w3 x3+48 ; for alarm text;
rs w3 x2 ;
al w2 x2-2 ;
se w0 0 ;
jl. a2. ;
c. i205
rl. w1 b6.+10 ; w1:=interrupt addr.
sh. w1 (f7.) ; if interrupt addr inside boss core then
sh. w1 f0. ;
jl. a5. ; begin
al w1 x1-i205+2 ; w1:=first addr of test code;
al w0 i205<6+22; w0:=no of bytes, kind=22;
jl. w3 d21. ; call coruno output;
a5: al. w1 b6. ; end;
z.
al w0 14<6+9 ; w0:= 14 bytes, kind 9
jl. w3 d21. ; call coruno output
jl. w2 c24. ; call outblock
rl. w0 f36. ; if kind of test medium <> bs then
sn w0 4 ; begin
jl. a3. ;
al w0 10 ; change operation to outmark;
hs. w0 f31. ; call outblock;
jl. w2 c24. ; end;
a3:
\f
; kll 3.4.73 break central ...2a...
c.e7 ; if fp mode then
al w2 12 ;
jl. w3 h33.-2 ; (outend(ff); goto wait);
z. ;
al. w1 b2. ;
jl. w3 c26. ; output main console(boss fault);
rl. w0 b6. ;
jd 1<11+28; print content of w0 on main console;
jl. 0 ; endless loop;
d25:
c26: al w2 x1+16 ; output main console: always 18 bytes text.
ds. w2 b4. ; set first and last address;
rs. w3 b3. ; save return;
a4: al. w1 b5. ;
al. w3 f16. ;
jd 1<11+10; (w3=main console) release process;
jd 1<11+16 ; send message to main console;
al. w1 c27. ;
jd 1<11+18 ; wait answer;
bl w1 x1 ; if attention status then
sz w1 1<4 ; repeat;
jl. a4. ;
jl. (b3.) ; return;
b1: jd -1 ;
b2: <:<10>***boss fault :>; alarm text
b0:
b7=k+4, 0, 0, 0, 10 ; remaining part of text
b8: 10 ;
b3: 0 ; return
b5: 5<12 ; output to main console
0 ; first address
b4: 0 ; last address
e.
\f
; kll 3.4.73 testoutput central ...3...
; test output from central logic
b. a10, b10 w. ;
c12: dl. w2 f46. ; test send: w1:= mess addr
rl w2 x2+8 ; w2:= name table addr;
al w0 8<6+1 ; w0:= 8 bytes, kind 1
jl. c20. ; goto w2 output
c13: rs. w1 b1. ; test lock: w2 = semaphor; save w1
am 2-4 ; w0:=2 bytes, kind 2
c15: ; test open:
al w0 2<6+4 ; w0:=2 bytes, kind 4
al w1 x2 ; w1:=addr of sem. value
jl. c20. ; goto w2 output
c14: rl. w1 f10. ; test opench: w1:= operation addr, w2 = semaphor
al w0 8<6+3 ; w0:= 8 bytes, kind 3
jl. c20. ; goto w2 output
c16: ds. w1 b1. ; test exit: save w0, w1; w2 = coruno
al w0 x2+6 ; w0:= page descr addr;
c.e8,rl. w0 f2. ; if abs mode then w0:= page 0 abs;
z. bz w2 x2+4 ; w2:= corutine ident;
ls w2 -3 ;
rs. w0 b5. ; page list addr := w0;
al w0 18<6+5 ; w0:= 18 bytes, kind 5;
jl. w3 c20. ; call w2 output;
rl. w2 f1. ; w2:= coruno;
jl. c17. ; goto end test;
c18: rs. w1 b1. ; test mess: save w1
am. (f10.) ;
rl w1 +8 ; w1:= mess buf addr(sender table index)
al w1 x1+6 ; w1:= addr of sender and operation
al w0 8<6+6 ; w0:= 8 bytes, kind 6
jl. d21. ; goto coruno output
c19: rs. w1 b1. ; test answ: save w1
rl w1 x1+2 ;
al w1 x1+4 ; w1:= ref result in answer;
al w0 2<6+7 ; w0:= 0 bytes, kind 7
jl. d21. ; goto coruno output
\f
; rc 1.3.71 testoutput central ...4...
; procedure w2 output: w0 = length < 6 + kind, w1 = address of words
; to output, w2 = first word to output. return: w2 unchanged,
; w3 = abs page 1, w0 - w1 reestablished by means of save cells.
d37:
c20: ds. w3 b3. ; w2 output: save w2 - 3
a1: rs. w2 b4. ; first word:= w2
rs. w0 b7. ; save length, kind
ls w0 -6 ;
wa. w0 f38. ; w0:= length + current test addr;
am. (f33.) ;
sl w0 -2 ; if w0+2 >= last addr then
jl. w2 c24. ; outblock; only w1 saved.
rl. w0 b7. ; w0:= saved length, kind;
sn w0 18<6+5 ; if test exit then
al w0 16<6+5 ; length:= 16, kind:= 5...;
rx. w0 b7. ;
jl. w3 c23. ; outkind; w1 saved.
al w3 0 ;
rl w0 106 ; w3, w0:= microsec + time
aa w0 110 ;
ss. w0 f39. ; w3,w0:= (time-start time) mod 2**29;
la. w3 b8. ;
wd. w0 b6. ; w0:=time:=w3,w0 // 100;
jl. w3 c22. ; outword(time)
rl. w0 b4. ;
jl. w3 c22. ; outword(first word);
a3: rl. w2 b7. ; rep: w1=addr of word to output.
al w2 x2-2<6 ; decrease length by 2;
rs. w2 b7. ;
sn w2 8<6+5 ; if test exit and length=8 then
rl. w1 b5. ; w1:= page list addr;
rl w0 x1 ; w0:= word to output;
al w1 x1+2 ; w1:= next;
al. w3 a3. ; prepare return to rep;
sl w2 0 ; if length >= 0 then
jl. c22. ; outword(word) return to rep
am. (f1.) ; if test exit then
bz w0 +5 ;
am. (f2.) ;
bz w1 +10 ; w1:=page ident;
hs w1 0 ; w0:=page ident, rel exit;
sn w2 -2<6+5 ; outword(page ident, relative exit);
jl. w3 c22. ;
dl. w1 b1. ; reestablish w0, w1, w2
rl. w2 b2. ;
am. (f2.) ;
rl w3 +2 ; w3:= abs page 1;
jl. (b3.) ; return
\f
; kll 3.4.73 testoutput central ...4a...
; procedure coruno output: w0 = length < 6 + kind, w1 = address of
; words to output. return: as w2 output. w3=page 1 abs, w2 unchanged.
d21: ds. w3 b3. ; coruno output: save w2 - 3
rl. w2 f1. ;
bz w2 x2+4 ; w2:= corutine ident;
ls w2 -3 ;
jl. a1. ; goto w2 output
b1= k+2, 0, 0 ; saved w0, w1
b2: 0 ; saved w2
b3: 0 ; saved w3
b4: 0 ; first word
b5: 0 ; page list addr
b6: 100 ;
b7: 0 ; saved length, kind
b8: 31 ; mask
e. ; end test output
\f
; rc 3.3.71 testoutput central ...5...
; outword and outblock
b. a10, b30 w. ;
c23: c.e7 ; outkind: w1 saved, w0 = word to output
ds. w1 b1. ; if fp mode then begin
rs. w3 b3. ;
rl. w0 f1. ; w0:= old corutine;
rx. w0 b9. ; old corutine := corutine;
al w2 10 ; prepare outnl;
se. w0 (b9.) ; if w0 <> corutine then
jl. w3 h26.-2 ; fp outchar on current output;
rl. w0 b19. ;
ls w0 18 ; w0:= saved length, kind;
ls w0 -16 ; w0:= min(2*kind,2*10);
sl w0 11<2 ;
al w0 10<2 ;
am (0) ; w0:= text addr(w0)
al. w0 b2. ;
jl. w3 h31.-2 ; fp outtext on current output
dl. w1 b1. ; reestablish w0, w1, w3
rl. w3 b3. ;
jl. a1. ;
b19:
b1= k+2, 0, 0 ; saved w0, w1, w3. only in fp mode
b3: 0 ;
b2= k-4, <:<10>send<0>:>, <:<10>lock<0>:>, <:<10>opch<0>:>
<:<10>open<0>:>, <:<10>exit<0>:>, <:<10>mess<0>:>
<:<10>answ<0>:>, <:<10>jd-1<0>:>, <:<10>stop<0>:>
<:<10>priv<0>:>
b9: 0 ; old corutine
z. ; end fp mode
c22: c.e7 ; outword: w1 saved, w0 = word to output
ds. w1 b1. ; if fp mode then begin
rs. w3 b3. ; save w0, w1, w3
jl. w3 h32.-2 ; fp outinteger on current output
1<23 + 32<12 + 8 ; 8 positions
dl. w1 b1. ;
rl. w3 b3. ; reestablish w0, w1, w3
z. ; end fp mode
a1: rx. w1 f38. ; save w1, w1:= current addr
rs w0 x1 ; store word in buffer
al w1 x1+2 ; current addr := next;
rx. w1 f38. ; get saved w1
jl x3 ; return
a2: rs. w3 b4. ; send op: save return
al. w3 f35. ; w3:= test document
jd 1<11+16; send message
bz w3 x1 ; w3:= operation;
al. w1 b5. ;
jd 1<11+18; wait answer
rl. w1 b5. ; w1:= status in answer
se w0 1 ; if result = normal or
sn w3 8 ; operation = unload then
jl. (b4.) ; goto return else
jl. a3. ; goto inactivate;
\f
; rc 3.3.71 testoutput central ...6...
d36:
c24: ds. w2 b7. ; outblock: save w1, return;
al w0 0 ; buf(current addr):=0;
rs. w0 (f38.) ; may use a word outside buffer.
rs. w0 b8. ; parity count:= 0
se. w0 (f37.) ; if activate <>0 then
jl. a4. ; goto exit
a6: al. w1 f31. ; send:
jl. w3 a2. ; send op(output block), w1 = status
rl. w0 f36. ;
se w0 4 ; if kind = bs then
jl. a5. ; begin
sz. w1 (b10.) ; if status = hard then
jl. a3. ; goto inactivate
rl. w0 f34. ;
ba. w0 1 ; segment count:= segment count + 1
rs. w0 f34. ;
sn w1 0 ; if status = 0 then
jl. a4. ; goto exit
rl. w0 f47. ; segment count:= cycle start
rs. w0 f34. ; goto send
jl. a6. ; end;
a5:
c. e6
sz. w1 (b17.) ; if end of tape then
jl. a7. ; goto end of tape;
z.
sz. w1 (b11.) ; if status = hard then
jl. a3. ; goto inactivate
so. w1 (b12.) ; if status <> parity then
jl. a4. ; goto exit
rl. w0 b8. ;
ba. w0 1 ; parity count:= parity count + 1
rs. w0 b8. ;
sl w0 6 ; if parity count >= 6 then
jl. a3. ; goto inactivate
al. w1 b13. ;
jl. w3 a2. ; send op(backup block)
al. w1 b14. ;
jl. w3 a2. ; send op(erase)
jl. a6. ; goto send
a3:
jd 1<11+30; testoutput of status;
al. w1 b15. ; inactivate:
jl. w3 c26. ; output main console(inactive);
rs. w2 f37. ; activate := <>0;
a4: rl. w1 b6. ; exit: w1:= saved w1;
rl. w2 f32. ;
rs. w2 f38. ; current addr := first addr;
jl. (b7.) ; return
\f
; rc 3.3.71 testoutput central ...7...
c. e6
a7: al. w1 b18. ; end of tape:
jl. w3 a2. ; sendop(output mark);
sz. w1 (b12.) ;
jl. a7. ; if parity then goto end of tape;
al. w1 b20. ;
jl. w3 a2. ; send op(unload tape);
al. w1 b19. ;
jl. w3 c26. ; output main console(change testoutput tape);
rl. w2 (f51.) ; w2:= process descr addr for test medium;
a8: rl w0 x2+22 ; rep:
se w0 2 ; if state <> remote pressed then
jl. a8. ; goto rep;
am (66) ;
dl w1 +74 ;
al. w3 b21. ; set catalog base to boss max interval;
jd 1<11+72;
rl w1 x2+10 ;
ls w1 -6 ; w1:= device number(w2);
al. w3 f35. ;
jd 1<11+54; create peripheral process(bosstest);
se w0 0 ; if not ok then
jl. a3. ; goto inactivate;
jd 1<11+6 ; initialize process;
se w0 0 ; if not ok then
jl. a3. ; goto inactivate;
al. w1 b22. ;
jl. w3 a2. ; send op(rewind tape);
jl. a4. ; goto exit;
z.
b4: 0 ; return from sendop
c27: ; also used by output main console
b5: 0, r.8 ; answer
b6: 0 ; save w1 in outblock
b7: 0 ; save w2 in outblock
b8: 0 ; parity count
b10: -1-1<18 ; hard error mask, bs: all except end document
b11: -1-1<23-1<22-1<15-1<14-1<16; hard error mt: all except intervention, parity,
; write enable, high density, tape mark
b12: 1<22 ; mask for parity error
b13: 8<12 ; move operation, backup block
3 ;
b14: 6<12 ; erase operation
b15: <:<10>*** test output inactive<10>:>
b16= k-2 ;
c. e6
b17: 1<18 ; end of tape
b18: 10<12 ; output mark
b19: <:<10>***change testoutput tape<10>:>
b20: 8<12, 5 ; unload tape
b21: 0 ; used by set cat base
b22: 8<12, 4 ; rewind tape
z.
e. ;
\f
; rc 7.12.71 variables central ...8...
f1: e9 a. 1 ; coruno
f2=f1+2, 0 ; corunocode
f3=k-2,f13=f3+2,0,0 ; answer
f4=k-2,f14=f4+2,0,0 ; activ
f5: -1,0,0 ; pagerqueue
f6: 0 ; waiting for buffer
f7: 0 ; max core (virt(z)=>max core place)
f8: 6 ; current priority
f9: 0 ; last real entry of coretable
f10: 0, r.9 ; work (used by wait answer)
f11: 1 ; writing
f16: 0, r.5 ; name of main console
f20: 0 ; coruno table start (pager)
f21: 0 ; first of core table
f22: 0 ; postrecord in of sendertable
f23: 0 ; first core place
f24: 1<23 ; segmenttable base
;f25 see pager
f26: <:drumcore:>,0,0 ; drum name
f27: <:disccore:>,0,0 ; disc name
f28: 0 ; first drum segment
f29: 0 ; number of drum segments
;f30 ; length of central logic
f31: 5<12 ; test output operation:
f32: 0 ;
f33: 0 ;
f34: 0 ;
f35: <:bosstest:>,0,0; name of test medium
f51=k-2 ; name table addr of test medium
f36: 0 ; kind of test medium
f37: 0 ; test output activ
f38: 0 ; current test addr
f39=k+2,0,0 ; boss start time
;f40 ; length of resident part init
f41: 0 ; core table length
f42: 0 ; search limit
f43: 0 ; for set base
f44=k+2, 0, 0 ; work for prep term access
f45: 0 ; base file access table
f46=f10+2 ; for addressing in test output
f47: 0 ; cycle start (test output on bs)
;f48, f49 slang checksums
\f
; rc 18.2.71 send and wait central ...9...
b. a2 w. ; send and wait:
; w1=mess, w2=name, w3=return;
d0: ds. w2 f10.+2 ; save w1,w2;
al w2 0 ; w2:= 0;
jl. a1. ; goto send;
; send and wait virtual:
d1: am 1<8-1<9; fast:
d2: al w0 1<9 ; slow:
ds. w2 f10.+2 ; save w1,w2
rl w2 x1+2 ;
ws. w2 f23. ; w2:= first addr of mess-first core place;
ls w2 -9 ;
ls w2 2 ; w2:= 4*core index + core table base;
wa. w2 f21. ;
bz w2 x2+3 ; w2:= first segment in page;
am. (f24.) ;
bz w2 x2 ; w2:= segment table(first segment in page);
wa. w2 f21. ; w2:= core table address for first segm in page;
wa w0 x2+1 ;
rs w0 x2+1 ; coretab(w2):= coretab(w2)+bufferbit(fast or slow);
a1: rl. w1 f1. ; send: w1:= coruno;
rs w2 x1+10 ; page2(coruno):= w2;
ws. w3 f2. ;
hs w3 x1+5 ; relreturn:= w3-coruno code;
al. w2 f3. ;
jl. w3 d9. ; put in chain(coruno,answer);
rl. w1 f10. ; w1:= message addr;
rl. w3 f10.+2 ; w3:= name addr;
jd 1<11+16; send message;
a2: sh w2 0 ; after send:
c. -1, o6, z. ; (bossfault xref)
jd -6 ; if claim exceeded then goto alarm;
rl. w1 f1. ; w1:= coruno;
rs w2 x1+2 ; state(coruno):= mess buf addr;
bz w0 x1+4 ;
sz w0 1 ; if test(coruno) = central test then
jl. w3 c12. ; test send;
jl. d12. ; goto wait;
d26: rl. w1 f1. ; stop and wait: w1:=coruno;
ds. w2 f10.+2 ; save process name addr; f10:=beware of testoutput;
al w2 0 ;
rs w2 x1+10 ; page 2(coruno):= 0;
ws. w3 f2. ;
hs w3 x1+5 ; rel return:= w3 - coruno code;
al. w2 f3. ;
jl. w3 d9. ; put in chain(coruno, answer);
rl. w3 f10.+2 ; w3:= process name;
jd 1<11+60; stop process;
jl. a2. ; goto after send;
d35: rl. w1 f1. ; wait answer: w1:= coruno;
ws. w3 f2. ; used in transmit.
hs w3 x1+5 ; rel return:= w3 - coruno code;
sh w2 0 ; if claim exceeded then
c. -1, o6, z. ; (bossfault xref)
jd -6 ; alarm;
rs w2 x1+2 ; state(coruno):=mess buf addr;
al. w2 f3. ;
jl. w3 d9. ; put in chain(coruno, answer);
jl. d12. ; goto wait;
e.
\f
; rc 18.2.71 lock central ...10...
b. a5 w. ; lock: lockchained:
; w2=semaphor addr, w3= return;
d3:
d5: rl. w1 f1. ; w1:= coruno;
ws. w3 f2. ;
hs w3 x1+5 ; relreturn:= w3-coruno code;
bz w0 x1+4 ;
sz w0 1 ; if test(coruno) = central test then
jl. w3 c13. ; test lock;
rl w3 x2 ; w3:=semaphor;
sl w3 1 ; if semaphor < 1 then
jl. a1. ; begin
al w3 x3-1 ;
a2: rs w3 x2 ; semaphor:= semaphor-1;
al w0 0 ; state(coruno):= 0;
rs w0 x1+2 ; put in chain(coruno,semaphor);
jl. w3 d9. ; goto wait;
jl. d12. ; end;
a1: rl w3 x2+2 ;
se w3 0 ; if first(sem) <>0 then
rs w3 x1+10 ; page 2(coruno):= first(sem);
rs w2 x1+2 ; state(coruno):= semaphor addr;
jl. c5. ; goto check pages;
; lock after check pages:
; w1=coruno
c1: rl w2 x1+2 ; w2:= semaphor addr;
rl w3 x2 ; w3:= semaphor-1;
al w3 x3-1 ; if semaphor < 1 then
sh w3 -1 ; goto wait for the semaphore;
jl. a2. ;
rs w3 x1 ; (test output of semaphore value);
rl w0 x2+2 ; if first(sem)= 0 then
se w0 0 ; begin comment unchained;
jl. a3. ; semaphor:= semaphor-1;
rs w3 x2 ; goto exit to coruno;
jl. c7. ; end else
a3: se w0 (x1+10) ; if page 2(coruno) = first(sem) then
jl. a4. ; begin comment chained;
rs w3 x2 ; semaphor:=semaphor-1;
rl. w1 f2. ; (test output of semaphore value);
rl w1 x1+4 ;
rl w3 x1 ;
rs w3 x2+2 ;
jl. c7. ; end else
a4: rs w0 x1+10 ; begin comment snatched away under its very nose;
jl. c5. ; page 2(coruno):= first(sem);
; goto check pages;
e. ; end;
\f
; rc 18.2.71 open central ...11...
b. a1 w. ; open chained:
; w1=operation, w2= semaphor addr, w3=return;
d6: rl w0 x2 ; chain(operation):=semaphor value
rs w0 x1 ; (for testoutput)
rs. w1 f10. ; save operation;
rl. w1 f1. ;
ws. w3 f2. ;
hs w3 x1+5 ; relreturn:= w3 - coruno code;
bz w1 x1+4 ;
sz w1 1 ; if test(coruno) = central test then
jl. w3 c14. ; test open chained;
rs. w2 (f10.) ; chain(operation):=semaphore addr;
rl. w0 f10. ;
ws. w0 f23. ; w0:= operation addr - first core place;
ld w1 -9 ; w3:= core index;
rl w3 0 ;
ls w3 2 ; w3:= 4*core index;
am. (f21.) ; w0:= segment no:= core index
ba w0 x3+0 ; - core index for first + segment no for first;
ld w1 +9 ; w0:= virtual operation;
rl. w1 f1. ; w1:= coruno;
lo. w0 f11. ;
rs w0 x1+2 ; state(coruno):= virtual operation + writing;
rl w0 x2+4 ;
rs w0 x1+10 ; page 2(coruno):= last(sem);
jl. c5. ; goto checkpages;
; open chained after check pages:
; w0=state, w1=coruno, w2=corunocode;
c2: jl. w3 c11. ; check one page(state);
rl w3 0 ; w3:= abs operation;
rl w2 x3 ; w2:= semaphor addr;
rl w0 x2 ; w0:= semaphor+1;
ba. w0 1 ;
sl w0 1 ; if sem<0 then
jl. a1. ; begin comment activate;
rs w0 x2 ; sem:= sem+1;
jl. w3 d10. ; get from chain(w1:=first in que,sem);
jl. w3 d11. ; put in chain(first in que,activ);
am. (f1.) ;
rl w0 +2 ; page 2(first in que):= state(coruno);
rs w0 x1+10 ; comment virtual operation;
rl. w1 f1. ; w1:= coruno;
al w0 0 ;
rs w0 x1+2 ; state(coruno):= page 2(coruno):=0;
rs w0 x1+10 ;
; page 2 abs not cleared. will appear in test output from exit.
jl. c7. ; goto exit to coruno;
a1:
e.
\f
; rc 18.2.71 open central ...12...
b. a3 w. ;
rl w2 x2+4 ; end else
se w2 (x1+10) ; if last(sem)= page 2(coruno) then
jl. a3. ; begin
al w2 0 ; chain(operation):= page 2(coruno):= 0;
rs w2 x1+10 ;
rx w2 x3 ; w2:= semaphor addr;
rs w0 x2 ; sem:= sem+1;
rl w0 x1+2 ; w0:= last(sem):= virtual operation;
rs w0 x2+4 ;
rl w3 x2+2 ;
se w3 0 ; if first(sem)=0 then
jl. a2. ;
rs w0 x2+2 ; first(sem):= virt operation;
jl. c7. ; else
a2: am. (f2.) ; chain(op):= virtual(operation);
rs w0 (4) ; goto exit to coruno;
jl. c7. ; end;
a3: rs w2 x1+10 ; page 2(coruno):= last(sem);
jl. c5. ; goto check pages;
; open:
; w2 = semaphor addr, w3 = return;
d4: rs. w3 f10. ; save w3
ds. w1 f10.+4 ; save w01;
rl. w1 f1. ; w1:= coruno;
bz w0 x1+4 ;
sz w0 1 ; if test(coruno) = central test then
jl. w3 c15. ; test open;
rl w1 x2 ;
al w1 x1+1 ; semaphor:= semaphor+1;
rs w1 x2 ;
sl w1 1 ; if semaphor <= 0 then
jl. a1. ; begin comment activate;
jl. w3 d10. ; get from chain(w1:= first in que, sem);
jl. w3 d11. ; put in chain(first in que, activ);
a1: am. (f2.) ; end;
rl w3 +2 ;
dl. w1 f10.+4 ; get w01;
jl. (f10.) ; w3:= abs page 1; goto return;
e.
\f
; rc 18.2.71 get pages etc. central ...13...
b. a3 w. ;
d7: rl. w1 f1. ; getpages:
rl w2 x1+6 ; w2:= page 0;
ws. w3 f2. ; w3:= w3 - abs addr page 0;
jl. d8. ; goto page jump;
; w1=return, w2=virt jump, w3=rel jump.
d17: am. (f2.) ; call:
am (+2) ;
al w0 +2 ; addr of return point := page 1 abs + 2;
d34: rs. w0 f10. ; w0 call: work:= addr of return point;
ws. w1 f2. ; w1:= rel return;
am. (f1.) ;
rl w0 +6 ; w0:= page 0 descr;
ds. w1 (f10.) ; store return point;
; page jump:
; w2 = page 0, w3 = rel return;
d8: rl. w1 f1. ; w1:= coruno;
rs w2 x1+6 ; page 0(coruno):= w2;
hs w3 x1+5 ; relreturn(coruno):= w3;
al w0 0 ;
rs w0 x1+2 ; state(coruno):= 0;
jl. c5. ; goto checkpages;
; clear core:
; w3 = rel return;
d14: rl. w1 f1. ; w1:= coruno;
al w0 0 ;
rs w0 x1+2 ; state(coruno) := 0;
ws. w3 f2. ;
hs w3 x1+5 ; relreturn:= w3 - page 0;
jl. c10. ; goto page missing;
; put in chain(w1, activ):
d11: al. w2 f4. ; w2:= activ;
; w1 = coruno, w2 = semaphor addr;
d9: al w0 0 ; put in chain: w0:= 0;
rs w0 x1 ; chain(coruno):= w0;
rl w0 x2+2 ;
se w0 0 ; if first(sem) = 0 then
jl. a2. ; comment empty chain;
rs w1 x2+2 ; first(sem):= last(sem):= coruno;
rs w1 x2+4 ; else
jl x3 ;
a2: rs w1 (x2+4) ; last(sem):= chain(last(sem)):= coruno;
rs w1 x2+4 ;
jl x3 ; goto return;
; w1:= coruno, w2 = semaddr;
d10: rl w1 x2+2 ; get from chain:
rl w0 x1 ; w1:= first(sem);
rs w0 x2+2 ; first(sem):= chain(w1);
jl x3 ; goto return;
e. ;
\f
; rc 10.11.71 wait and exit central ...14...
b. a3 w. ; central wait and check pages;
c10: rl. w2 f5. ; page missing:
al w2 x2+1 ;
rs. w2 f5. ; pagerque:= pagerque + 1;
se w2 0 ; if pagerque = 0 then
jl. a2. ; begin
rl. w1 f20. ; w1:= pager descr;
rs w2 x1+2 ; state(pager):=0;
jl. w3 d11. ; put in chain(pager, activ);
a2: rl. w1 f1. ; end;
al. w2 f5. ; w1:= coruno; w2:= pagerque;
jl. w3 d9. ; put in chain(coruno, pagerque);
d12: rl. w1 f14. ; wait:
rs. w1 f1. ; w1:= coruno:= first(activ);
se w1 0 ; if coruno = 0 then
jl. a3. ; begin
c3: al w2 0 ; first event: event:= 0;
c4: jd 1<11+24; next event: wait event(event);
se w0 0 ; goto if result = answer then
jl. c8. ; answer received else message received;
jl. c9. ; end;
a3: rl w0 x1 ;
rs. w0 f14. ; first(activ):= chain(coruno);
d13: ; exit from pager:
c5: rl w0 x1+6 ; checkpages:
jl. w3 c11. ; w0:= check one page(page 0);
rl w2 0 ; switches to c10 if page is missing;
rs. w2 f2. ; w2:= coruno code:= w0;
rs w2 x2 ; core(coruno code + 0):= check one page(page 0);
rl w0 x1+8 ;
jl. w3 c11. ;
rs w0 x2+2 ; core(coruno code+2):= check one page(page 1);
rl w0 x1+10 ;
jl. w3 c11. ;
rs w0 x2+4 ; core(coruno code+4):= check one page(page 2);
rl w0 x1+12 ;
jl. w3 c11. ;
rs w0 x2+6 ; core(coruno code+6):= check one page(page 3);
rl w0 x1+14 ;
jl. w3 c11. ;
rs w0 x2+8 ; core(coruno code+8):= check one page(page 4);
e. ;
\f
; rc 18.2.71 wait and exit central ...15...
b. a6 w. ; exit to coruno and answer
; w1 = coruno, w2 = coruno code;
rl w0 x1+2 ;
sl. w0 (f0.) ; if state(coruno) > boss start then
jl. a2. ; goto semaphor or virtual;
se w0 0 ;
jl. a1. ; if state(coruno) <> 0 then goto waiting for answer;
rl w1 x2+4 ; w1:= abs page 2;
c25 : ; after clean:
c7: rl. w2 f1. ; exit to coruno: w0, w1 contains exit value;
sn. w2 (a6.) ; if -, same corutine then
jl. a5. ; begin
rx. w1 f8. ; get cur-prio, save w1
al w1 x1+2 ; increase cur-prio
sl w1 1<8 ; if prio>=max then
jl. c21. ; goto clean
rx. w1 f8. ; save cur-prio, get w1
rs. w2 a6. ; save new coruno
a5: ; end ;
bz w3 x2+4 ; w2:= coruno;
sz w3 1 ; if test(coruno) = central test then
jl. c16. ; goto test exit;
c17: rl. w3 f2. ; end test:
rl w3 x3+2 ; w3:= abs page 1;
bz w2 x2+5 ;
c.-1 ;****** test version ******
b. a10 w.
ds. w1 a8. ; save regs;
ds. w3 a9. ;
rl w1 76 ; w1:=first area in nametable;
a0: al w2 x1 ; rep:
ls w2 -1 ;
wa. w2 f45. ;
bl w0 x2 ; w0:=entrycount.w1;
sh w0 -1 ; if entrycount<0 then
c.-1, o7, z. ;
jd -7 ; bossalarm;
sn w0 0 ; if entrycount>0 then
jl. a1. ; begin
rl w3 x1 ; w3:=area process addr;
rl w0 x3+14 ; w0:=users.area process;
am (66) ;
sz w0 (+12) ; if boss not user
jl. a1. ; then
al w0 24<6+21; privout areaprocess
al w1 x3-4 ;
jl. w3 d21. ;
bl w0 x2 ; w0:=entry count
c.-1, o8, z. ;
jd -8 ; bossalarm;
; end;
a1: al w1 x1+2 ; w1:=next in nametable;
se w1 (78) ; if not first internal then
jl. a0. ; goto rep;
dl. w1 a8. ; restore regs;
dl. w3 a9. ;
jl. a10. ;
a8=k+2, 0, 0 ; saved w0w1
a9=k+2, 0, 0 ; saved w2w3
a10: ;
e.
z. ;****** test version ******
am. (f2.) ;
jl x2 ; jump page 0 + rel return;
a6: 0 ; saved coruno
a1: al. w1 f10. ; waiting for answer:
rl w2 0 ;
jd 1<11+18; waitanswer(work addr, state = buffer addr);
rs w0 x1+16 ; save result;
al w2 1 ;
ls w2 (0) ; w2:= 1<result;
sn w2 2 ; if normal answer then
lo w2 x1 ; w0:= w0 or w2;
al w0 x2 ; comment logical status;
jl. c7. ; goto exit to coruno;
a2: sh. w0 (f7.) ; semaphor or virtual:
jl. c1. ; if state < max core then goto lock after checkpages;
jl. c2. ; else goto open after checkpages;
; w2 = answer addr ;
c8: al. w1 f13. ; answer received: w1:= first(answer);
a3: al w3 x1 ; rep: w3:=w1;
rl w1 x3 ; w1:=chain(w1);
sn w1 0 ; if end chain then
jl. c4. ; goto next event;
se w2 (x1+2) ; if state(w1)<> buffer addr then
jl. a3. ; goto rep;
rl w2 x1 ; comment found;
rs w2 x3 ; chain(w3):=chain(w1);
sn w2 0 ; if last in chain then
rs. w3 f3.+4 ; last(answer):=w3;
rs. w1 f1. ; coruno:=w1;
bz w0 x1+4 ;
sz w0 1 ; if test(coruno) = central test then
jl. w3 c19. ; test answer;
al w3 0 ; w3:= coretabref:= page 2(coruno);
rx w3 x1+10 ; page 2(coruno):= 0;
sn w3 0 ; if coretabref = 0 then
jl. c5. ; goto checkpages;
rl w2 x3 ;
la. w2 a4. ;
rs w2 x3 ; coretab(w3):= coretab(w3) - buffer bits;
rl. w2 f6. ;
se w2 -1 ; if pager not waiting for buffer then
jl. c5. ; goto checkpages;
jl. w3 d11. ; put in chain(coruno, activ);
al w0 0 ;
rs. w0 f6. ; waiting for buffer := false;
rl. w1 f20. ; coruno:=pager;
rl w2 x1+6 ; corunocode:=page0(pager);
ds. w2 f2. ;
jl. d20. ; goto pager buffer free;
a4: 2.111111 111111 110011 111111; remove buffer bits;
e.
\f
; rc 18.2.71 message central ...16...
b. a6 w. ; message
; w2 = buffer addr, w0 = 0;
c9: rl. w1 f22. ; message received:
rl w3 x2+6 ; w1:= post record in sender table; w3:= sender;
sl w3 0 ; if message regretted then
jl. a1. ; begin
al w0 1 ; get event;
jd 1<11+26; send answer;
jd 1<11+22; goto first event;
jl. c3. ; end;
a1: rs w3 x1-e15*10 ; sender(last in sender table):= sender;
a2: al w1 x1-10 ; while sender(x1) <> sender do
se w3 (x1) ; x1:= x1-sender table record length;
jl. a2. ;
a5: rl w3 (x1+2) ; w3:= semafor;
; sender. mess: 0 no message in que
; 1 message in que, corutine busy
; >1 address of message got
al w0 1 ; w0:=sender.mess;
rx w0 x1+8 ; sender.mess:=1;
sl w0 2 ; if message got then
rs w0 x1+8 ; sender.mess:= w0;
sh w0 1 ; if message got or
sl w3 0 ; semafor>-1 then
jl. c4. ; goto next event;
rs w2 x1+8 ; sender.mess:= message buffer addr;
al w3 x3+1 ;
rs w3 (x1+2) ; semaphor:= semaphor + 1;
jd 1<11+26; get event(w2);
rl w2 x1+2 ; w2:= semaphor addr;
rs. w1 f10. ; save sender table index;
jl. w3 d10. ; get from chain(w1:= coruno, sem);
rs. w1 f1. ; coruno:= w1;
bz w0 x1+4 ;
sz w0 1 ; if test(coruno) = central test then
jl. w3 c18. ; test mess;
rl. w3 f10. ;
al w3 x3+4 ;
rs w3 x1+10 ; page 2(coruno):= sender table index+4;
jl. c5. ; goto checkpages;
e.
\f
; rc 10.11.71 check one page central ...17...
; check one page: w0 = virtual addr, w0 = abs address at return.
; if the page is not in core, the routine switches to d24.
b. a10, b10, w. ;
c11: sh. w0 (f7.) ; check one page: if virt addr <= max core then
jl x3 ; return
rs. w3 b3. ; save w1, w2, w3;
ds. w2 b2. ;
al w3 0 ;
ld w0 15 ; w3:= segm no; w0:= relative;
am. (f24.) ;
bz w2 x3+0 ; w2:= segm table(segm no);
sz w2 1<1 ; if page not in core then
jl. c10. ; goto page missing;
wa. w2 f21. ; w2:= core table addr for segment;
rl w1 x2 ; w1:= first segm - core index, priority;
bs w3 2 ; w3:= core index for wanted segment in page;
la. w1 b4. ; clear priority part and in core bit;
wa. w1 f8. ; priority part:= curr priority;
so. w0 (b5.) ; if virtual address is odd then
jl. a2. ; begin
lo. w1 f11. ; priority:= priority or writing;
ws. w0 b5. ; w0:= relative of virt:= relative of virt - 1;
a2: rs w1 x2 ; end;
ld w0 -15 ; store priority in core table;
wa. w0 f23. ; w0:= core index shift 9 + relative + first core place;
dl. w2 b2. ; reestablish w1, w2;
jl. (b3.) ; return;
c21: rs. w0 b10. ; clean: save w0
rl. w0 f12. ; w1 = curr priority.
sh w0 -1<7 ; w0:= vivid;
al w0 -1<7 ;
rs. w0 f12. ; vivid:= max(vivid, -max prior/2);
wa w0 2 ; w0:= decrement:= curr priority + vivid;
ws w1 0 ; w1:= curr priority:=
rx. w1 f8. ; curr priority - decrement; save cur-prio;
rs. w1 b2. ; save old w1, sawed in f8 at c7 (page 15)
rl. w2 f21. ; w2:= core table base;
a4: bl w1 x2+1 ; rep4:
la. w1 b7. ; w1:= priority part;
sl w1 (0) ; priority:= if priority part >= decrement
rl w1 0 ; then priority - decrement
ac w1 x1 ; else priority - priority part;
ba w1 x2+1 ;
hs w1 x2+1 ;
al w2 x2+4 ; w2:= next core table entry;
sh. w2 (f9.) ; if w2 <= last of core table then
jl. a4. ; goto rep4;
dl. w1 b2. ; w0,w1:= saved values
jl. c25. ; goto after clean; increases curr priority;
b10=k,b2=k+2, 0, 0, b3: 0 ; saving;
b4: -1<8+1-1<10,b5: 1<15, b7: 1<8-2 ; masks;
e.
\f
; sl 3.12.71 prepare access central ...18...
; prepare access: w01 = interval, w2 = name, name table address,
; w3 = return.
; return to x3: no entry visible, w3 = page 1 abs.
; return to x3 + 2: area process created, name table addr set,
; w01 = boss catalog base = interval of area process,
; w2 = total number of accesses to area process, w3 = page 1 abs.
b. a10 w. ;
a4: ; workspace used for testoutput of kind 20
0 ; +0: name table address
0 ; +2: increment
0 ; +4: access count ( after incrementation )
0,0 ; +6,+8: interval of process
0,r.4 ; +10,+12,+14,+16: name
d32: ds. w3 f44. ; prepare access: save name addr, return;
jd-1 ; low base, high base, name addr, return;
al. w3 f43. ;
jd 1<11+72; set catalog base;
al w3 x2 ; w3:= name addr;
jd 1<11+52; create area process;
rs w0 x3+8 ; name table addr:= dummy;
se w0 0 ; if result <> area proc created
jl. a1. ; then goto abnormal return;
al. w1 f26. ;
jd 1<11+16; send dummy message;
al. w1 f10. ;
jd 1<11+18; wait answer;
sn w0 2 ; if rejected then
am -1 ; increment:=0
; else
al w2 1 ; increment:=1;
\f
; kll 3.4.73 prepare access central ...18a...
a3: dl w1 x3+2 ; count: w3 = name addr, w2 = increment.
ds. w1 a4.+12 ; test:
dl w1 x3+6 ; name
ds. w1 a4.+16 ;
rl w1 x3+8 ; name table
ds. w2 a4.+2 ; increment
sh w1 50 ; w1:= name table addr;
jl. a2. ; if dummy then goto return;
ls w1 -1 ;
wa. w1 f45. ; w1:= access table addr(name);
ba w2 x1 ; w2:= access table:=
; testversion:
bl w0 x1 ; if old
sl w0 0 ; or new value < 0 then
sh w2 -1 ;
c. -1, o2, z. ; (bossfault xref)
jd -2 ; bossfault 2;
hs w2 x1 ; access table + increment;
rl w1 (x3+8) ;
dl w1 x1-2 ; w01:= interval of process;
al. w3 f43. ;
rs. w2 a4.+4 ; test: value
ds. w1 a4.+8 ; base
jd 1<11+72; set catalog base;
al w0 18<6+20; length, type
al. w1 a4. ;
jl. w3 d21. ; testoutput(a4);
rl. w3 f44.-2 ; w3:= saved name addr;
rl w1 (x3+8) ; w1:= proc descr addr;
rl w0 x1+14 ; w0:= users;
am (66) ; beware of remove entry:
so w0 (+12) ; if boss is not user then
jl. a2. ; goto return;
sn w2 0 ; if access table = 0 then
jd 1<11+64 ; remove process;
a2: rl. w0 a4.+2 ; return:
sn w0 0 ; if increment=0 then
jl. a1. ; goto abnormal return;
sl w1 51 ; w1= proc descr addr or dummy.
dl w1 x1-2 ; if not dummy then
am. (f2.) ; w01:= interval;
rl w3 +2 ; w3:= page 1 abs;
am. (f44.) ;
jl +2 ; return to x3 + 2;
a1: rs w0 x3+8 ; abnormal return: name table address := dummy
am. (f2.) ;
rl w3 +2 ; w3:= page 1 abs;
jl. (f44.) ; return to x3;
; terminate access: w2 = name, name table address, w3 = return.
d33: al w3 x3-2 ; terminate access: decrease return;
jd-1
ds. w3 f44. ; save name addr, return;
al w3 x2 ; w3:= name addr;
al w2 -1 ; w2:= increment:= -1;
jl. a3. ; goto count;
e.
i.e. ; end central
\f
; rc 17.2.71 pager central ...19...
; segment table: one entry for each segment in drum core and disk
; core, plus one dummy top entry. each entry is one byte. the
; address of the first entry is
; segm table base + (max core + 2) //512.
; format of segment table entry:
; s-2 section not in core.
; s+4*c first segment of section is in core with core index c.
; s is 0 for first segment in section, 1 for later segments.
; the dummy top element contains -2.
;
; segment places in core: the segment places are 512 bytes each. a
; segment place is denoted by a core index, c. c = 0, 1, 2 . . .
; the address of the first byte in segment place c is
; first core place + 512 * c
;
; core table: one entry for each segment place in core, plus one
; dummy top entry. each entry is 4 bytes. the address of the first
; byte (byte 0) in an entry is
; core table base + 4 * c
; format of core table entry:
; byte 0: first segm - core index both refer to first segm of section.
; byte 1: priority format below.
; byte 2: length format below
; byte 3: segment number refers to first segment in section.
; < 0 for free places and job area.
; the dummy entry has priority = 4095, length = 4 - total length of table,
; segment number = -1.
;
; format of priority:
; job < 11 + in core < 10 + buffers < 9 + bufferf < 8 + priority < 1 + writing
; job = 1 for a job place, in core = 1 for a page requested and in core already,
; buffers = 1 for buffers used for slow transfers, bufferf = 1 for buffers used
; for fast transfers, priority is updated at each reference, writing = 1
; when data in the page will be changed.
;
; format of length:
; 4*no of segments in section for first segment,0 for later segments.
; 4 for a free segment and later segment places for a job.
;
; page information list: one entry for each of the 5 page descriptions + state
; for a corutine. each entry is 5 words as follows:
; 0: not used for pages in permanent core. otherwise the entry is
; chained to not_in_core or in_core.
; 2: not used or chains to not_scheduled
; 4: first segment in page
; 6: length of page = 4 * no of segments
; 8: scheduled place = 4 * core index
\f
; rc 10.11.71 pager central ...20...
b. b30, c10 w. ;
b0: 0 ; -2 save
b1: 0 ; save
b2: 0 ; saved corutine
b3: 1<23 ; handle job page
b4: 0 ; in core ch, chains pages in core
b5: 0 ; not in core ch, chains pages not in core
f12:
b6: -2 ; vivid, current priority + vivid is limit for
f25: ; vivid segments. vivid must be even
b7: 0 ; victim, address of coretable entry to be
; tested next time by find room
b8: 0 ; not scheduled chain, chains those pages
; not in core which are not scheduled
b9: -1<1 ; mask for segment table entry
b10: 0, r.25 ; page inf list, 5 words for state and each of
b11: 0, r.5 ; the 5 pages in the corutine description
b12: 0 ; saved return
b13: 0, r.4 ; operation to backing store
b14= k+2, 0, 0 ; work for procedure
b15= k+2, 3,-4 ; increments, clear place (actually 4,-4, because of the carry from -4)
b16= k+2, 0, 4<12+4095 ; empty entry in core table
b17: 0 ; saved return from clear place
b18: 0 ; skipped job places
b19: 1<11 ; job-prio-bit whith zeroes in front
b20: 4095 ; all-prio-bits whith zeroes in front
b21: -1<12 ; negative signbits
; handling of job page: pager activated here when a corutine needs
; page transfers. page 4 is handled if it is a job place description.
d24: 0,0,0,0,0 ; start page 0:
9<12+0 ; page ident: pager
d23: rl. w1 f5.+2 ; entry pager: w1:= first in pager que
rl w2 x1 ; remove corutine from pager que
rs. w2 f5.+2 ;
rs. w1 b2. ; handling of job page: saved corutine:= w1
rl w0 x1+14 ; w0:= page 4
sl w0 0 ; if job place then
jl. c2. ; begin
ws. w0 b3. ; w0:= first segm, top segm
bs w0 0 ; w0:= first segm, no of segments
ls w0 2 ; w0:= place length
bz w1 0 ; w1:= place
bz w0 1 ; w0:= length
ds. w1 b1. ; save length, place
jl. w3 c1. ; clear place(w0, w1)
rl. w3 b1. ;
wa. w3 f21. ; w3:= place + core table base
rs. w3 b7. ; victim:= w3;
al w0 -2048 ; adjust core table:
hs w0 x3+1 ; priority:= 1<11; i.e. job
rl. w0 b0. ; length:= saved length
hs w0 x3+2 ; w1:= saved corutine addr
rl. w1 b2. ; end;
\f
; rc 17.2.71 pager, init central ...21...
; initialise page inf: initialises the page information list according
; to the pages in the corutine description. pages in core are put into
; one chain, pages not in core are put into another chain.
b. a10 w.
c2: al. w2 b10. ; initialise page inf: w2:= first page inf
al w0 0 ;
rs. w0 b4. ; in core ch:= not in core ch:= 0
rs. w0 b5. ;
am -2 ; first time: w0 := state;
a1: rl w0 x1+4 ; rep1: w1+4 = page descr addr, w2 = page inf addr
ds. w2 b1. ; save w1, w2
rl w1 0 ; w1 := page descr or state;
sh. w1 (f7.) ; if page descr <= max core then
jl. a5. ; goto next page
ls w1 -9 ; w1:= segm no
wa. w1 f24. ; w1:= addr of segm table(segm no)
bz w3 x1 ; w3:= segm table(segm no)
sz w3 1<1 ; if w3 < 0 then
jl. a2. ; goto page not in core;
la. w3 b9. ; page in core:
rs w3 x2+8 ; page inf.scheduled place:= w3 evened
wa. w3 f21. ; w3:= addr of core table entry
rl. w0 b4. ;
rs w0 x2+0 ; page inf.chain:= in core ch
rs. w2 b4. ; in core ch:= page inf addr
al w0 1<10 ;
lo w0 x3+0 ; priority:= priority + in core
rs w0 x3+0 ;
bl w1 x3+2 ;
bl w0 x3+3 ; w1:= page inf.length:= length
ds w1 x2+6 ; w0:= page inf.first segm:= first segm
jl. a5. ; goto next page
a2: ; page not in core: w3 = segm table(segm no)
so w3 1 ; rep1: w1 = addr of segm table(segm no)
jl. a3. ; if not first in page then
al w1 x1-1 ; begin segm no:= segm no -1
bl w3 x1 ; adjust w1, w3 accordingly; goto rep1
jl. a2. ; end;
a3: al w0 x1 ; w0:= addr of segm table(first segm)
a4: al w1 x1+1 ; rep4: segm no:= segm no +1
bl w3 x1 ; adjust w1, w3 accordingly
sz w3 1 ; if not first in next page then
jl. a4. ; goto rep4
ws w1 0 ; w1:= length:=
ls w1 2 ; 4*(last segm - first segm)
ws. w0 f24. ; w0:= first segm:= w0 - segm table base
ds w1 x2+6 ; store in page inf, w2 = page inf addr
jl. w3 c3. ; chain to not in core(w2)
\f
; rc 10.11.71 pager, allocate central ...22...
a5: dl. w2 b1. ; next page:
al w1 x1+2 ; w1+6:= addr of next page descr
al w2 x2+10 ; w2:= addr of next page inf
sh. w2 b11. ; if page inf addr <= last page inf then
jl. a1. ; goto rep1
; allocate pages: finds suitable places for the segments. the
; result is marked as scheduled place in page inf.
rl. w0 b5. ; allocate pages:
sn w0 0 ; if not in core ch = 0 then
jl. c5. ; goto exit pager
rl. w1 b6. ;
wa. w1 f8. ;
jl. w3 c6. ; find room(current priority + vivid)
rl. w1 b6. ; returns if no room
al w1 x1+6 ; punish by decreasing number of vivid
sl w1 0 ; segments.
al w1 -2 ; vivid:= min(-2, vivid + 6)
rs. w1 b6. ;
al w1 1<9-1 ;
jl. w3 c6. ; find room(buffer slow priority - 1)
a6: rl. w2 b4. ; rep6: w2:= in core ch
sn w2 0 ; if in core ch <> 0 then
jl. a7. ; begin
rl w0 x2 ; w0:=in core ch:=chain(w2);
rs. w0 b4. ;
jl. w3 c3. ; chain to not in core(w2)
dl w1 x2+8 ; w1:= scheduled place, w0:= length
jl. w3 c1. ; clear place(w0, w1); goto rep6
jl. a6. ; end;
a7: rl. w2 f21. ; victim:= core table base; start from
rs. w2 b7. ; base to get all holes as large as possible.
al w1 2047 ;
jl. w3 c6. ; find room(job priority - 1)
c. -1, o4, z. ; (bossfault xref)
jd -4 ; if no room then alarm
\f
; rc 17.2.71 pager, transfer central ...23...
; transfer pages: clears the scheduled places. transfers the pages
; and updates core table and segment table.
c4: rl. w2 b5. ; transfer pages: w2:= not in core ch
a9: dl w1 x2+8 ; rep9: w1:= scheduled place, w0:= length
jl. w3 c1. ; clear place(w0, w1)
rl. w2 b5. ; adjust core table: w2:= not in core ch
rl w1 x2+8 ;
wa. w1 f21. ; w1:= addr of core table(scheduled place)
rs. w1 b1. ; save:= addr of core table
rl w3 x2+4 ; w3:= first segment of page
al w0 x3 ;
ls w0 2 ; w0:= first segm - core index
ws w0 x2+8 ; := (first segm*4 - scheduled place)//4
ls w0 -2 ;
rl w2 x2+6 ; w2:= length of page
hs w2 6 ; w3:= length, first segment
a10: hs w0 x1 ; rep10: core table.first segm - core index:= w0
rs w3 x1+2 ; core table.length, first segm:= w3
bz w3 7 ; w3:= 0, first segment
aa. w2 b15. ; w1:= core table addr:= core table addr +4
sl w2 1 ; w2:= length:= length -4
jl. a10. ; if length >= 1 then goto rep10
rl. w1 b1. ; w1:= saved core table addr
al w0 3 ; transfer section, adjust segment table:
jl. w3 c7. ; transfer(w0 = input, w1 = core table addr)
rl. w2 b5. ; w2:= not in core ch
rl w1 x2+4 ;
wa. w1 f24. ; w1:= first segm + segm table base
am -1 ; w0:= first:= 0 else
a8: al w0 1 ; rep8: w0:= first:= 1
wa w0 x2+8 ;
hs w0 x1 ; segm table(segm):= scheduled place + first
al w1 x1+1 ; segm:= segm +1
bl w0 x1 ;
sz w0 1 ; if not first segm of next page then
jl. a8. ; goto rep8
rl w2 x2 ;
rs. w2 b5. ; w2:= not in core ch:= chain(w2)
se w2 0 ; if not last page then
jl. a9. ; goto rep9
e.
\f
; rc 17.2.71 pager, exit central ...24...
; exit pager: simulates a lock (pagerque) and returns to cl
; which exits to the corutine just processed by the pager.
c5: rl. w2 f5. ; exit pager:
al w2 x2-1 ; pagerque:= pagerque -1
rs. w2 f5. ;
rl. w1 f20. ; w1:= pager descr addr
sl w2 0 ; if pagerque >= 0 then
jl. w3 d11. ; put in chain(pager, activ que)
al w0 d23-d24;
hs w0 x1+5 ; rel return(pager):= entry-page0;
al w0 0 ;
rs w0 x1+2 ; state(pager):=0;
rl. w1 b2. ;
rs. w1 f1. ; coruno:= saved coruno
jl. d13. ; goto check pages
; chain to not in core: w2 = page inf addr, w2 saved at return
; inserts the page into the chain of pages not in core, so that the lengths
; are descending through the chain. if the section is in the list
; already, it is not inserted again (e.g. two pages in same section).
b. a10 w. ;
c3: rs. w3 b12. ; chain to not in core: save return
dl w0 x2+6 ; w0:= length of new page; w3:= first segment
al. w1 b5. ; w1:= right place:=
rs. w1 b14. ; addr of not in core ch
a1: rl w1 x1 ; rep: w1:= next page inf addr
sn w1 0 ;
jl. a2. ; if end of chain then goto insert
sn w3 (x1+4) ; if first segment of new = w1.first segment
jl. (b12.) ; then return
sh w0 (x1+6) ; if length of new <= w1.length then
rs. w1 b14. ; right place:= w1
jl. a1. ; goto rep
a2: rl. w1 (b14.) ; insert: w1:= right place.chain
rs. w2 (b14.) ; right place.chain:= new page inf
rs w1 x2 ; new page inf.chain:= w1
jl. (b12.) ; return
e. ;
\f
; rc 17.2.71 pager, procs central ...25...
; clear place: w0 = length(4*no of segments), w1 = place(4*core index)
; clears the core area specified. the end and the beginning of the
; area may not match existing section boundaries. the cleared core
; table entries will have priority 0, length 4, first segm -1.
b. a10 w. ;
a1: aa. w1 b15. ; rep1: w0:= length:= length+4; w1:= place:= place-4
c1: am. (f21.) ; clear place:
bl w2 x1+2 ; w2:= core table(place).length
sn w2 0 ; if length = 0 then
jl. a1. ; goto rep1
; w1 points to beginning of a section
rs. w3 b17. ; save return(b12 used by transfer)
wa. w1 f21. ; w1:= addr of core table(place)
a2: ds. w1 b14. ; rep2: save length, addr of place
bl w2 x1+1 ; w2:= priority
sz w2 1<9+1<8; if buffer then
jl. a6. ; goto wait buffer
bl w3 x1+3 ; w3:= first segm
sh w3 -1 ; if first segm < 0 then
jl. a4. ; goto adjust core table
wa. w3 f24. ; adjust segment table: w3:= first segm + segm table base
am -1 ; w0:= not in core:= -2 else
a3: al w0 -1 ; rep3: w0:= not in core:= -1
hs w0 x3 ; segm table:= not in core
al w3 x3+1 ; w3:= next entry in segm table
bz w0 x3 ;
sz w0 1 ; if not first of next page then
jl. a3. ; goto rep3
a4: al w0 5 ; adjust core table: w0:= output operation
sz w2 1 ; if priority = writing then
jl. w3 c7. ; transfer(w0 = output, w1)
dl. w1 b14. ; w1:= addr of place
bs w0 x1+2 ;
rs. w0 b14.-2 ; w0:= length:= length-core table.length
bl w2 x1+2 ; w2:= entry length:= core table.length
dl. w0 b16. ; w3, w0:= empty entry
a5: ds w0 x1+2 ; rep5: core table:= empty
aa. w2 b15. ; core table:= next; w2:= entry length-4
sl w2 1 ; if entry length > 0 then
jl. a5. ; goto rep5
rl. w0 b14.-2 ; w0:= length; remaining segments to clear
sl w0 1 ; if length > 0 then
jl. a2. ; goto rep2
jl. (b17.) ; return
\f
; rc 17.2.71 pager, procs central ...26...
a6: al w0 -1 ; wait buffer:
rs. w0 f6. ; waiting for buffer:= true
jl. d12. ; goto wait
d20: dl. w1 b14. ; w0:= saved length; w1:= saved addr of place
jl. a2. ; goto rep2
e. ;
; transfer: w0 = operation (3 or 5), w1 = core table address.
; transfers a section described in core table to or from virtual
; drum or disk.
b. a10 w. ;
c7: rs. w3 b12. ; transfer: save return
hs. w0 b13. ; operation:= w0
al w2 x1 ;
ws. w2 f21. ; w2:= (core table addr - core table base) *512 /4
bz w3 x1+2 ;
ld w3 7 ; w3:= length in bytes:= length*512 /4
wa. w2 f23. ; w2:= first addr:= w2+first core place
wa w3 4 ; w3:= last addr:=
al w3 x3-2 ; length in bytes+ first addr - 2
ds. w3 b13.+4 ;
bz w0 x1+3 ;
ws. w0 f28. ; w0:= first segm - first drum segm
al. w2 f26. ; w2:= name of virt drum area
am. (f29.) ;
sh w0 -1 ; if w0 >= no of drum segments then
jl. a1. ; begin w0:= disk segment:=
ws. w0 f29. ; w0 - no of drum segments
al. w2 f27. ; w2:= name of virtual disk area
a1: rs. w0 b13.+6 ; end; segment:= w0;
al. w1 b13. ; w1:= message
jl. w3 d0. ; send and wait
se w0 2 ; if not normal answer then
c. -1, o3, z. ; (bossfault xref)
jd -3 ; alarm
jl. (b12.) ; return
e. ;
\f
; rc 17.2.71 pager, procs central ...27...
; find room: w1 = limit (max priority to be overwritten).
; returns if room cannot be found for all pages in not in core chain.
; exits to transfer pages otherwise. page inf then describes the
; scheduled place.
b. a11 w. ;
c6: rs. w3 b12. ; find room: save return
rl. w0 b7. ; stop:= victim
ds. w1 b14. ; limit:= w1
rl. w2 b5. ; copy not in core chain:
rs. w2 b8. ; not scheduled chain:= w2:= not in core chain
a1: rl w3 x2 ; rep1: page inf.not sch ch:=
rs w3 x2+2 ; page inf.chain
al w2 x3 ; w2:= page inf addr:= next
se w2 0 ; if not end chain then
jl. a1. ; goto rep1
al w1 0 ; w1:= skipped job places:= 0;
rl. w3 b7. ; w3:=victim;
a3: bz w2 x3+2 ; w2:= lengt of page
bz w0 x3+1 ; rep3: w0:= victim.priority
sh. w0 (b14.) ; if priority > limit then
jl. a4. ; begin
so. w0 (b19.) ; if not job-place then
jl. a11. ; goto addres next page
sn. w0 (b20.) ; if prio= allbits (top dummy entry)
lo. w2 b21. ; then make lengt negative to swop around
wa w1 4 ; skipped:= skipped + length in w2
a11: wa w3 4 ; w3:= victim:= victim + length in w2
a2: se. w3 (b14.-2); pass vivid sections: if victim <> stop then
jl. a3. ; goto rep3; return no room
rs. w3 b7. ; set victim correct before return
jl. (b12.) ; end
a4: rs. w1 b18. ; save skipped job places;
al w1 0 ; find free sections: w1:= total:= 0
al w0 x3 ; w0:= place:= victim-core table base
ws. w0 f21. ;
a5: ba w1 x3+2 ; rep5: w1:= total:= total + length
ba w3 x3+2 ; w3:= victim:= victim + length
sn. w3 (b14.-2); if victim = stop then
jl. a6. ; goto use free section
bz w2 x3+1 ; w2:= victim.priority
sh. w2 (b14.) ; if priority <= limit then
jl. a5. ; goto rep5
\f
; rc 10.11.71 pager, procs central ...28...
a6: rs. w3 b7. ; use free section: victim:= w3, w0 = place
al. w3 b8.-2 ; w3:= prev:= addr of not sched ch - 2
rl w2 x3+2 ; w2:= addr of page inf, w1 = total
a7: am (x2+6) ; next page inf:
sh w1 -1 ; if total >= length of page then
jl. a8. ; begin
rs w0 x2+8 ; page inf.scheduled place:= place
wa w0 x2+6 ; w0:= place:= place + length of page
ws w1 x2+6 ; w1:= total:= total - length of page
rl w2 x2+2 ; w2:= page:= addr of next page
rs w2 x3+2 ; prev.not sch ch:= addr of next page
sn w2 0 ; if addr of next page = 0 then
jl. a9. ; goto end free section
jl. a10. ; end else begin
a8: al w3 x2 ; prev:= addr of page inf
rl w2 x3+2 ; w2:= addr of page inf end;
a10: se w2 0 ; if not end chain then
jl. a7. ; goto next page inf
a9: rl. w2 b8. ; end free section:
rl. w1 b18. ; w1:= skipped job places;
rl. w3 b7. ; w3:=victim;
se w2 0 ; if not scheduled chain <> 0 then
jl. a2. ; goto pass vivid sections
wa. w0 f21. ; last not used := w0 := place+core table base;
rs. w0 b7. ; wictim:= last not used
ws. w0 b14.-2 ; w0:= search length:=
ws. w0 b18. ; last not used - stop - skipped job places;
rl. w2 b6. ;
sh. w0 (f42.) ; if search length > search limit then
am -4 ; vivid:= vivid + 2 else
al w2 x2+2 ; vivid:= vivid - 2;
sl w2 0 ;
al w2 -2 ; vivid:= min(-2, vivid);
rs. w2 b6. ;
jl. c4. ; goto transfer pages
e.
i. e. ; end pager
\f
; rc 7.12.71 init central ...29...
; core layout:
;
; pass 1: pass 2: run:
;
; central logic central logic central logic
;
; pager pager pager
;
;
; init init
;
; external table external table
;
; drumcoretable drumcoretable
;
; diskcoretable diskcoretable
;
; move virt buf move virt buf
;
; corutine corutine
;
;
;
; coretable coretable
;
; segmenttable segmenttable
;
; semaphortable semaphortable semaphortable
;
; terminal buffers terminal buffers terminal buffers
;
; sender table sender table sender table
;
; corutine table corutine table corutine table
;
; file access table file access table file access table
;
; run test buf run test buf run test buf
;
;
;
;
;
;
;
;
; content:
;
; start of init d16 page 31
; next pass c1 page 35
; end init c2 page 35
; simulate lock c3 page 38
; dummy c4 page 38
; move to virtual c5 page 38
; reserve virtual c6 page 39
; end pass c10 page 41
; end initialize c11 page 44
; init trouble c12-c22 page 45
; corutine name list g0 page 47
;
\f
; rc 10.11.71 init, variables central ...30...
b. c35,g10 w.
b. b70,j40 w.
b0: ; start of init core
b1: 3<12 ; input of corut
b2: 0 ; first addr
b3: 0 ; last addr
0 ; segment number
b4: 0 ; bytes wanted
b10: 0,r.10 ; work (used by wait answer)
b12: 0 ; pass 1 or 2
b14: 0 ; postrecord of: corutine table
b15: 0 ; semaphor table
b16: 0 ; sender table
b17: 0 ; disk or drum:
b18: 0 ; start of segmenttable
b20=2, 0 ; last not empty
b21=4, 0 ; segment number base
b22=6, 0 ; last of segment table+2
b19: 0,0,1<14,0 ; initial segment number base of disk:= 1<14
b23: 0 ; start of final segment table
b25: 0 ; minhole
b26: 0 ; index
b27: e3 ; max corut size
b28: e14*e12 ; length of: coruno table
b30: e15*10 ; sender table
b31: i3*i4+i3 ; terminal buffer area
b32: e1 ; virtual drum area
c. i27, <:drum:>,0,0 z. ;
c.-i27, <:disc:>,0,0 z. ;
0,r.5 ;
b33: e2 ; virtual disk area
<:disc:>,0,0 ; disc
0,r.5 ;
b35: 3<12 ; input from virt
b36: 0 ; first addr
b37: 0 ; last addr
b38: 0 ; segment
b40: 5<12 ; output to virt
b41: 0 ; first addr
b42: 0 ; last addr
b43: 0 ; segment
b45: 0 ; last of corutine+2
b46: 512+4 ; denominator for coretable
b47: 0 ; last of boss
0,b48: 4<12+4095 ; initial content of coretable
0,b49: 0 ; saved register
0,b50: 0 ; saved register
b52: 0 ; saved rel
b53: 4095 ; last entry in coretable
b54: 0<12+4095 ; last entry in coretable
b55: 0 ; fp base
b57: h. 9<3+e89,d23-d24 w. ; testmode,rel entry pager
0,b60: 0 ; saved cat base
b59: 0 ; for set base
b61: i11 ; fraction, for core table search limit
b62: 100 ; - - - - - -
b63: e3+2 ; max corutine length + 2
b64: 8<12, 6 ; move operation, set position
b65: 10 ; constant
b66: <:<10>testoutput on file :>, <:<0><0><0>:>, <:<10><0><0>:>
b67: 100<6+14 ; output ext table
b69: g5. ; rel top of external table = start of drum table
\f
; rc 7.12.71 init, init central ...31...
b58: 0 ; addr of f0
j1 =f1 -f0,j22=f22-f0,j16=f16-f0
j33=f33-f0,j32=f32-f0,j20=f20-f0
j7 =f7 -f0, j9= f9-f0,j21=f21-f0
j23=f23-f0,j24=f24-f0,j26=f26-f0
j38=f38-f0,j28=f28-f0,j29=f29-f0
b. a9 w. ;start of init:
d16: ; w2 = if fp then top free core else undef;
rs. w1 b55. ; b55:= fpbase;
rs w3 x3 ; f0:=boss start
rs. w3 b58. ;
c. -e7 ; if no fp then
am.(4,jl.+2,g8.) ; begin
g9: rl w1 66 ; move program;
dl w2 x1+24 ; w2:= top storage addr;
rs w1 x1 ; boss start:= first storage addr;
rs. w1 b58. ;
z. ; end;
rl w1 66 ;
dl w1 x1+70 ;
ds. w1 b60. ; save current cat base;
rl w3 78 ; proc:= first internal;
a2: rl w1 x3 ; rep: w1:= descr(proc);
rl w0 x1+50 ;
se w0 (66) ; if parent(w1) = ego then
jl. a3. ;
sl w2 (x1+22) ; w2:= min(w2, first storage(w1));
rl w2 x1+22 ;
a3: al w3 x3+2 ; proc:= proc + 1;
sh w3 (80) ; if proc <= last then
jl. a2. ; goto rep;
al w2 x2-4 ; dummy word after run test buf.
rs. w2 b47. ; b47:=last of boss core;
e.
b. a10 w.
rl. w3 b58. ; w3 := addr of f0;
rs w2 x3+j33 ; f33 := last of runtest buffer;
al w2 x2-510 ;
rs w2 x3+j32 ; f32 := first of runtest buffer;
rs w2 x3+j38 ; f38 := first of runtest buffer;
rl w2 74 ;
al w1 x2+i1<1 ;
rl w2 x2+i1<1 ;
rs w1 x3+j16+8 ; name table address;
dl w1 x2+4 ; copy name of main console;
ds w1 x3+j16+2 ;
dl w1 x2+8 ;
ds w1 x3+j16+6 ;
al w0 0 ;
al w3 x3+6 ; interrupt addr := f0+6;
jd 1<11+0 ;
\f
; sm 75.06.06 init, init central ...31a...
rl w2 76 ; w2:= area;
a0: rl w3 x2 ; next area process:
dl w1 x3+4 ;
ds. w1 b10.+2 ;
dl w1 x3+8 ; move name(area);
ds. w1 b10.+6 ;
dl w1 x3-2 ;
al. w3 b59. ; set cat base(area);
jd 1<11+72;
al. w3 b10. ; remove area process(area);
jd 1<11+64;
al w2 x2+2 ; area:= area + 1;
se w2 (78) ; if area <> top then
jl. a0. ; goto next area process;
rl. w3 b58. ;
al w3 x3+f35-f0 ; w3 := test medium name addr;
jd 1<11+8 ; reserve process;
sn w0 0 ; if -,ok then
jl. a1. ; begin
jd 1<11+52 ; create area process;
jd 1<11+8 ; reserve process;
; rs w0 x3+f37-f35; comment test output active := result;
al w0 4 ; kind of medium := bs;
rs w0 x3+f36-f35; end;
a1: al. w1 b10. ; w1:= work;
jd 1<11+16 ; send and wait sense to
jd 1<11+18 ; set name table addr;
rl. w0 b10.+6 ; w0:= file no of answer;
sh w0 -1 ; if file no is undefined then
al w0 0 ; file no:= 0;
al w1 0 ; block no:= 0;
ds. w1 b10.+6 ; set(file no, block no) in message;
dl. w1 b64.+2 ; set(move, set position) in message;
ds. w1 b10.+2 ;
al. w1 b10. ; w1:= message address;
jd 1<11+16; send and wait(move operation);
jd 1<11+18;
rl w1 x3+f36-f35; if kind of medium <> bs
sn w1 4 ; then
jl. a2. ; begin comment magtape..;
dl. w2 b10.+6 ; w1:= 0; w2:= file no of answer;
wd. w2 b65. ; convert file no into numbers
al w1 x1+48 ; and save in text;
se w2 0 ;
al w2 x2+48 ;
lo. w2 b66.+12;
rs. w2 b66.+12;
rs. w1 b66.+14;
al. w1 b66. ; w1:= <:testoutput on file:>;
jl w3 x3+d25-f35; outtext on main console;
a2: ; end;
e.
\f
; sm 75.06.06 init, init central ...31b...
b. a10 w.
al w0 0 ;
al. w1 g7. ;
a1: rs w0 x1 ; zero fill
al w1 x1+2 ; until last of boss core
sh. w1 (b47.) ;
jl. a1. ;
al. w1 b69. ;
wa w1 x1 ; w1:=top of external table
rs. w1 b18. ; b18:= start of drumtable;
al w0 e1 ;
ls w0 1 ;
wa w1 0 ;
rs. w1 b19. ; b19:= start of disk table;
rs. w1 b18.+b22 ; b18(last+2):=start of disk table;
al w0 e2 ;
ls w0 1 ;
wa w1 0 ;
rs. w1 b19.+b22 ; w1:=b19(last+2):=last of disk table+2;
rs. w1 b36. ; b36:= first of input from virtual
al w1 x1+510 ;
rs. w1 b37. ; b37:= last of input from virtual;
al w1 x1+16 ;
rs. w1 b2. ; b2:= first of corutine buf
wa. w1 b27. ;
rs. w1 b45. ; w1:=b45:=first free core;
rl. w3 b58. ; w3:= addr of f0;
rl w2 x3+j32 ; w2 := first of runtest buffer;
rl w1 76 ; w1:= - length file access table:=
ws w1 78 ; (first internal - first area in name tab)/2;
sz w1 2 ; round w1 down to an even number;
al w1 x1-1 ;
as w1 -1 ; w2:= first of file access table:=
wa w2 2 ; w2 - length file acess table;
ac w1 (76) ;
as w1 -1 ; w1:= first area in name tab/2;
wa w1 4 ; f45:= base file access table:=
rs w1 x3+f45-f0 ; first of file access table + w1;
rs. w2 b14. ; b14:= post record of corutine table
ws. w2 b28. ;
rs. w2 b16. ; b16:= post record of sender table;
rs w2 x3+j22 ; f22:=post record in sendertable;
rs w2 x3+j20 ; f20:= first of corutine table;
e.
\f
; kll 17.1.73 init, init central ...32...
b. a1 w.
ws. w2 b30. ;
rl. w3 b58. ; w3:=addr of f0;
ws. w2 b31. ;
rs. w2 b15. ; b15:= post record of semaphortable;
ws. w2 b45. ;
sh w2 0 ; free core:= b15-b45;
jl. c12. ; if free core<0 initalarm;
rl w1 116 ;
ls w1 -9 ;
rs w1 x3+j28 ; f28:= first drum segment;
rs. w1 b18.+b21 ; b18(base):= first drum segment;
ls w1 9 ;
al w0 x1-2 ;
rs w0 x3+j7 ; f7:= max core ;
rl. w0 b57. ; w0:=testmode,rel entry pager;
al w1 x3+d24-f0 ; w1:=addr page0 pager;
rl w2 x3+j20 ; w2:=addr descr pager;
ds w1 x2+6 ; init pager descr;
e.
\f
; rc 26.2.71 init, init central ...33...
rl. w3 b58. ; w3:= abs f0;
al. w0 g4. ;
al. w1 g4. ;
rs w0 x1+0<1 ; ext(0):= base of external table;
al w0 x3+d0-f0 ;
rs w0 x1+1<1 ; ext(1):= send and wait;
al w0 x3+d1-f0 ;
rs w0 x1+2<1 ; ext(2):= send and wait fast;
al w0 x3+d3-f0 ;
rs w0 x1+3<1 ; ext(3):= lock;
al w0 x3+d4-f0 ;
rs w0 x1+4<1 ; ext(4):= open;
al w0 x3+d5-f0 ;
rs w0 x1+5<1 ; ext(5):= lock chained;
al w0 x3+d6-f0 ;
rs w0 x1+6<1 ; ext(6):= open chained;
al w0 x3+d7-f0 ;
rs w0 x1+7<1 ; ext(7):= get pages;
al w0 x3+d8-f0 ;
rs w0 x1+8<1 ; ext(8):= page jump;
al w0 x3+d2-f0 ;
rs w0 x1+9<1 ; ext(9):= send and wait slow;
al w0 -1 ;
rs w0 x1+10<1 ; ext(10):= alarm;
al w0 x3+d14-f0 ;
rs w0 x1+11<1 ; ext(11):= clear core;
al. w0 c6. ;
rs w0 x1+12<1 ; ext(12):= reserve virt;
al. w0 c4. ;
rs w0 x1+13<1 ; ext(13):= dummy (move virt);
rs w0 x1+14<1 ; ext(14):= dummy (simulate lock);
rs w0 x1+24<1 ; ext(24):= dummy(put in activ chain);
\f
; kll 3.4.73 init, init central ...33a...
al. w0 c2. ;
rs w0 x1+15<1 ; ext(15):= end init;
al. w0 b0. ;
rs w0 x3+j23 ;
rs w0 x1+17<1 ; ext(17):= first core place;
al w0 x3+d21-f0 ;
rs w0 x1+21<1 ; ext(21):= coruno output;
al w0 x3+j16 ;
rs w0 x1+23<1 ; ext(23):= name of main console
al w0 x3+d17-f0 ;
rs w0 x1+25<1 ; ext(25):= call;
al w0 x3+j1 ;
rs w0 x1+26<1 ; ext(26):= current corutine;
al. w0 c7. ;
rs w0 x1+27<1 ; ext(27):= carriage return;
al w0 x3+f39-f0 ;
rs w0 x1+28<1 ; ext(28):= boss start time addr;
al w0 i116 ;
rs w0 x1+29<1 ; ext(29):= number of work places;
al w0 x3+d26-f0 ;
rs w0 x1+30<1 ; ext(30):= stop and wait;
al. w0 d27. ;
rs w0 x1+31<1 ; ext(31):= init alarm;
al. w0 d32. ;
rs w0 x1+32<1 ; ext(32):= prep access;
al. w0 d33. ;
rs w0 x1+33<1 ; ext(33):= term access;
al w0 x3+d34-f0 ;
rs w0 x1+34<1 ; ext(34):= w0 call;
al w0 x3+d35-f0 ;
rs w0 x1+35<1 ; ext(35):= wait answer;
al w0 x3+f42-f0 ;
rs w0 x1+36<1 ; ext(36):= search limit;
al w0 x3+f37-f0 ;
rs w0 x1+37<1 ; ext(37) := testoutput switch;
al w0 x3+f34-f0 ;
rs w0 x1+38<1 ; ext(38) := current segment in bosstest;
al w0 x3+f51-f0 ;
rs w0 x1+39<1 ; ext(39) := name table address(bosstest);
al. w0 c29. ;
rs w0 x1+40<1 ; ext(40):=set external;
rl. w0 b15. ;
rs w0 x1+150<1 ; ext(150):= start of terminal area;
\f
; rc 22.12.71 init, testoutput central ...34...
b. a10 w.
jl. a4. ;
a3: <:bos:>,0,r.12 ; coruno output, bos ident;
a5: 0, r.e29>1 ; name of installation
a9: e29<6 + 13 ; length, kind of init text
a6: e0. - h99 ; addr of installation name (in options)
; the following code is executed during assembling:
a7: al. w1 a5. ; move installation name;
al. w2 a6. ;
wa w2 x2 ;
a8: rl w0 x2 ;
rs w0 x1 ;
al w1 x1+2 ;
al w2 x2+2 ;
sz w0 255 ;
jl. a8. ;
al w0 0 ; ok-return to slang
al w2 0 ;
jl x3 ;
jl. a7. ; start jump-code;
j.
; end of jump-code
a4:
al w0 0 ;
rl w1 106 ; boss start time:= microsec + time;
aa w1 110 ;
ds w1 x3+f39-f0 ;
ds. w1 a3.+10 ;
dl w1 x3+6 ;
ds. w1 a3.+16 ; move version ident of bos
dl w1 x3+10 ;
ds. w1 a3.+20 ;
am (66) ; move first,last core;
rl w0 +22 ;
rl. w1 b47. ;
al w1 x1+2 ;
ds. w1 a3.+24 ;
al. w1 a5. ;
rl. w0 a9. ;
am. (b58.) ;
jl w3 d21-f0 ; coruno output(installation name);
al. w1 a3. ;
al w0 26<6+13; w0:= 26 bytes, kind 13;
am. (b58.) ;
jl w3 d21-f0 ; coruno output(bos ident);
e. ;
\f
; rc 4.2.72 init, loader central ...35...
b. a1 w.
c1: ; next pass:
am -10 ;
al. w0 g0. ;
rs. w0 g2. ; next name:= first name-10;
al. w3 (g4.) ; note: indirect to enable tracing ofexternal references
rl. w0 b14. ;
rs w0 x3+18<1 ; ext(18):= post record of coruno table;
rl. w0 b15. ;
rs w0 x3+19<1 ; ext(19):= post record of semaphor table;
rl. w0 b16. ;
rs w0 x3 +20<1 ; ext(20):= post record of sender table;
rl. w3 b18. ;
al w3 x3-2 ;
rs. w3 b18.+b20 ; b18(last not empty):= start-2;
rl. w3 b19. ;
al w3 x3-2 ;
rs. w3 b19.+b20 ; b19(last not empty):= start-2;
rl. w3 b18. ;
rl. w2 b19.+b22 ;
al w0 512 ;
a1: rs w0 x3 ; fill disk and drum table
al w3 x3+2 ;
sh w3 x2-1 ; with 512
jl. a1. ;
e.
b. a3 w.
c2: ; end init:
al. w3 b59. ;
dl. w1 b60. ; reestablish cat base
jd 1<11+72 ;
rl. w3 g2. ;
al w3 x3+10 ;
rs. w3 g2. ; x3:= nextname:= nextname + 10;
sl. w3 g1. ; if nextname > lastname then
jl. c10. ; goto end pass;
c.e7,al w2 10 ; if fp then
am. (b55.) ; begin
jl w3 h26-2 ; outchar(10);
rl. w0 g2. ;
am. (b55.) ; outtext(coruno name);
jl w3 h31-2 ; end;
z.
\f
; rc 26.4.72 init, loader central ...36...
rl. w3 g2. ; w3:= name addr;
jd 1<11+52 ; create area process;
al. w1 b10. ;
jd 1<11+42; lookup entry;
se w0 0 ;
jl. c13. ; if not exist then goto init trouble;
rl w1 x1+18 ; w1:=length(entry);
al w1 x1+511 ; round w1 up to segments
ls w1 -9 ;
ls w1 +9 ;
sl. w1 (b63.) ; if w1>max corutine area then
jl. c16. ; goto init trouble;
rs. w1 b4. ; bytes wanted:= w1;
wa. w1 b2. ;
rs. w1 b3. ; last addr:= first addr+bytes wanted;
al. w1 b1. ;
jd 1<11+16 ; send message
al. w1 b10. ;
jd 1<11+18 ; wait answer
se w0 1 ;
jl. c14. ; if result<>1 then goto init trouble;
rl. w1 b10.+2 ;
se w1 0 ;
se. w1 (b4.) ; if bytes transfered<>bytes wanted or = 0 then
jl. c15. ; goto init trouble;
jd 1<11+64 ; remove area process
rl. w2 b2. ; w2:= first addr; w3 = name addr.
dl w1 x3+2 ;
ds w1 x2-12 ; move name;
dl w1 x3+6 ;
ds w1 x2-8 ;
al. w3 (g4.) ; w3:= base external table;
; note: indirect to enable tracing of external references
dl w1 x3+19<1 ;
ds w1 x2-4 ;
rl w1 x3+20<1 ; move ext18, 19, 20;
rs w1 x2-2 ;
al w0 22<6+13; w0:= 22 bytes, kind 13;
al w1 x2-14 ;
am -2000 ;
jl. w3 d21.+2000; coruno output;
rl. w3 b2. ; w3:= first addr;
al w3 x3+8 ; w3:= first of external list;
\f
; sl 24.6.72 init, loader central ...37...
a1: rl w1 x3 ; rep: w1:= rel external word;
sl w1 1 ; if w1 <= 0 then
jl. a0. ; begin
sn w1 0 ; if w1 = 0 then
jl x3+2 ; exit to coruno;
ws w3 2 ; w3:= ext word addr - ext word;
jl. a1. ; goto rep;
a0: ; end;
wa w1 6 ; w1:= abs external word;
so w1 1 ; if w1 uneven then
jl. a2. ; begin
bl w2 x1 ; w2:= number * 2;
ls w2 1 ;
rl. w0 x2+g4. ; displacement(w1):=
hs w0 x1 ; external;
jl. a3. ; end else
a2: bl w2 x1+1 ; begin
ls w2 1 ; w2:= number * 2;
bz w0 x1 ; w0:=reservation
sh w2 -1 ; if external < 0 then
al w0 0 ; reservation:=0
ac w0 (0) ; w0:=-reservation
wa. w0 x2+g4. ; + external
rs. w0 x2+g4. ; external:=w0
rs w0 x1 ; external word:=external
; end;
a3: al w3 x3+2 ; w3:= next;
jl. a1. ; goto rep;
e.
; set externals:
; transferring externals from coroutine-initialisation to external table
; call return
; w0 irr. unchanged
; w1 irr. unchanged
; w2 irr. unchanged
; w3 table addr. return addr.
c28: 0, 0, 0
c29: rs. w0 c28. ; save registers
ds. w2 c28.+4 ;
al w3 x3+2 ; w3:=start of set-external-table
rl. w2 g4. ; w2:=start of external table
c30: rl w1 x3+2 ; rep: w1:=external number
sn w1 -1000 ; if stop number then
jl. c31. ; goto restore
ls w1 1 ;
sh w1 e4 ; if external outside limits
sh w1 -e5-2 ; then
jl. c24. ; goto alarm
wa w1 4 ; w1:=abs addr. of external
rl w0 x3 ; w0:=external value
rs w0 x1 ; ext(number):=w0
al w3 x3+4 ;
jl. c30. ; goto rep
c31: rl. w0 c28. ; restore:
dl. w2 c28.+4 ;
jl x3+4 ; return
\f
; rc 26.2.71 init, move to virt central ...38...
b. a3 w.
c3: rs. w3 b10. ; simulate lock:
rl w3 x2 ;
al w3 x3-1 ; semaphor:= semaphor-1;
rs w3 x2 ;
am. (b58.) ;
jl w3 d9-f0 ; put in chain(coruno,sem);
jl. (b10.) ; goto return;
c4: jl x3 ; dummy: goto return
c7: c. e7 ; carriage return:
ds. w1 b10.+2 ;
ds. w3 b10.+6 ; save registers;
al w2 10 ;
am. (b55.) ; outchar(10);
jl w3 h26-2 ;
dl. w1 b10.+2 ;
dl. w3 b10.+6 ; restore registers;
z. jl x3 ; return;
; move to virtual:
; entry: w0=start addr, w1=length, w2=virt addr, w3=return
; exit: w0,w1,w2,w3 unchanged
c5: ds. w3 b49. ;
ds. w1 b50. ;
rs. w0 b41. ; first addr:= w0;
al w1 x1+511 ;
ls w1 -9 ;
ls w1 9 ; bytes wanted:= w1 rounded up
rs. w1 b4. ; to a number of segments;
al w1 x1-2 ;
wa w1 0 ;
rs. w1 b42. ; last addr:= first addr+bytes wanted-2;
sl. w1 (b45.) ; if last addr>last of corutine then
jl. c16. ; goto init trouble;
ls w2 -9 ;
rl. w3 b58. ;
ws w2 x3+j28 ;
al w0 x2+1 ;
sh w0 (x3+j29) ;
jl. a1. ;
ws w2 x3+j29 ;
am f27-f26 ;
a1: al w3 x3+j26 ; w3:= name addr(virt addr);
rs. w2 b43. ;
rs. w2 b38. ; b43:= b38:= segment number;
rl. w0 b49.-2 ;
ls w0 15 ;
ls w0 -15 ; w0:= rel in segment;
rl. w1 b50. ;
sl w1 512 ; if length<512 then
jl. a3. ; begin
rs. w0 b52. ; b52:= saved rel;
al. w1 b35. ; send message input from virt
jd 1<11+16 ;
al. w1 b10. ;
jd 1<11+18 ; wait answer
rl. w1 b10.+2 ;
sn w1 512 ; if bytes transfered<>512 or
se w0 1 ; result<>1 then
jl. c17. ; goto init trouble;
\f
; rc 26.2.71 init, res virt central ...39...
rl. w1 b50.-2 ; w1:= start of page
rl. w2 b36. ;
wa. w2 b52. ; w2:= start of buf+rel;
al w0 x1-2 ;
wa. w0 b50. ;
rs. w0 b52. ; b52:= last move word;
a2: rl w0 x1 ;
rs w0 x2 ;
al w1 x1+2 ; move page to buffer;
al w2 x2+2 ;
sh. w1 (b52.) ;
jl. a2. ;
dl. w2 b37. ; first, last addr of output:=
ds. w2 b42. ; first, last addr of input;
a3: ; end;
al. w1 b40. ;
jd 1<11+16 ; send message(output);
al. w1 b10. ;
jd 1<11+18 ; wait answer;
lo. w0 b10. ; result or hard error;
rl. w1 b10.+2 ;
sn. w1 (b4.) ; if bytes transfered<>bytes wanted
se w0 1 ; or result<>1 then
jl. c18. ; goto init trouble;
dl. w3 b49. ; reestablish registers;
dl. w1 b50. ;
jl x3 ; goto return;
; reserve virtual:
; entry: w0 extract 1 = 0: drum else disk, w1=length of page
; exit: w0,w1 unchanged, w2= virtual addr
; when reserve virt is called successive on the same device
; with length >= 512 then the pages got will be consecutive.
c6: ds. w1 b10.+2 ;
rs. w3 b10.+4 ; save w0, w1, w3
sz w0 1 ;
am b19-b18 ;
al. w2 b18. ;
rs. w2 b17. ; b17:= table addr for drum or disk
rl w3 x2+b20 ; w3:= index:= last not empty+2;
al w3 x3+2 ;
e.
b. a8 w.
sh w1 510 ; if length>=512 then
jl. a5. ; begin
a0: al w0 x3 ; found:
ws w0 x2+0 ; w0:=(index-start)>1;
ls w0 -1 ;
wa w0 x2+b21 ; w0:=(w0+segment base)*512;
ls w0 9 ;
rl w2 x3 ;
ws w2 2 ; w2:= 512-core(index);
\f
; rc 22.12.71 init, res virt central ...40...
sh w2 0 ;
al w2 0 ; core(index):= max(0,core(index)-length);
rx w2 x3 ;
ac w2 x2-512 ;
wa w2 0 ; w2:= virt addr:= w0+w2;
rs. w2 b10.+6 ;
am. (b58.) ;
rl w0 j24 ; w0:= base segment table;
sh w0 0 ; if during pass 2 then
jl. a1. ; begin
ls w2 -9 ;
wa w2 0 ; segment table(virt addr):= -2;
al w0 -2 ;
hs w0 x2 ; w2:= saved virt addr;
rl. w2 b10.+6 ; test output, w1 = length, w2 = virt;
; end;
a1: sh w1 512 ; while length>512 do
jl. a3. ; begin
al w0 0 ;
rs w0 x3 ; core(index):= 0;
al w3 x3+2 ; index:= index+2;
al w1 x1-512 ; length:= length-512;
jl. a1. ; end;
a3: rl. w1 b17. ; w1:= table addr disk or drum;
rl w0 x1+b20 ; w0:= last not empty;
sl w0 x3-2 ;
jl. a4. ; if w0<index-2 then core(index):= 0;
al w0 0 ; comment do not use the
rs w0 x3 ; rest of a long section;
a4: sh w3 (x1+b20) ;
rl w3 x1+b20 ;
rs w3 x1+b20 ; last not empty:= max(last not empty,index);
sl w3 (x1+b22) ;
jl. c19. ; if last not empty>last then goto init trouble;
c.e7 ; if fp then
al w0 x2 ; outinteger(virt addr);
am. (b55.) ;
jl w3 h32-2 ;
1<23+32<12+8 ;
z. ;
dl. w1 b10.+2 ; reestablish w0,w1
jl. (b10.+4); goto saved exit
; end else
a5: al w0 512 ; begin
rs. w0 b25. ; minhole:= 512;
rs. w3 b26. ; index:= last not empty+2;
rl w3 x2+0 ;
jl. a8. ; for w3:=start step 2 until last not empty do
a6: rl w0 x3 ;
sl w0 x1 ; if core(w3)>=length and
sl. w0 (b25.) ; core(w3)<minhole then
jl. a7. ; begin
rs. w3 b26. ; index:= w3;
rl w0 x3 ; minhole:= core(w3);
rs. w0 b25. ; end;
a7: al w3 x3+2 ;
a8: sh w3 (x2+b20) ; w3:= index;
jl. a6. ; goto found;
rl. w3 b26. ;
jl. a0. ; end;
e.
\f
; rc 26.2.71 init, end pass central ...41...
b. a3 w.
c10: rx. w3 b12. ; end pass:
se w3 0 ; if after second pass then
jl. c11. ; goto end of initialize;
al. w3 b59. ;
am (66) ; set base to boss standard;
dl w1 +78 ; prepares for create drum, disccore;
jd 1<11+72;
rl. w3 b58. ; w3:= addr of f0;
al. w1 (g4.) ; w1 := abs external table;
; note: indirect to enable tracing of external references
al w0 4 ;
wa w0 x1+507<1 ; w0 := 4 + segments in jobfile + length of savebuf
wa w0 x1+508<1 ; + segments in fobdescr;
ac w2 i62 ; w2:= -length of save buffer
wa w2 x1+507<1 ; +length of save buffer + segments in jobfile
wa w2 x1+509<1 ; +length of psjob mount code + size of mount action table
; + size of mount table
wa w2 x1+510<1 ; +size of request line page
sh w0 (4) ;
al w0 x2 ; w0:=max( w0, w2 );
sl w0 i116+1 ; if w0 > i116 (= min segment places) then
jl. c23. ; alarm;
al. w0 c5. ;
rs w0 x1+13<1 ; ext(13):= move virtual;
al. w0 c3. ;
rs w0 x1+14<1 ; ext(14):= simulate lock;
al w0 x3+d11-f0 ;
rs w0 x1+24<1 ; ext(24):= put in activ chain;
rl w2 x1+52<1 ; move request free addr and
rs w2 x3+4 ; max request free (for performon)
rl w0 x2 ;
rs w0 x3+2 ;
rl. w1 b18.+b20;
ws. w1 b18. ;
al w1 x1+2 ;
ls w1 -1 ; w1:= number of segments in drumcore;
rs. w1 b32. ; b32:= w1;
am. (b58.) ;
rs w1 j29 ; f29:=w1;
wa. w1 b18.+b21 ;
rx. w1 b19.+b21 ; b19(base):=b18(base)+w1;
wa. w1 b19.+b21 ;
ls w1 9 ; w1:=1<23+b19(base)*512;
\f
; re 11.10.73 init, end pass central ...41a...
al. w2 g4. ;
al w3 x2+e4 ;
a1: rl w0 x2 ; for i:= first ext step 1 until last ext do
sh w0 -1 ; if ext(i)<0 then
wa w0 2 ; ext(i):=ext(i)+w1;
rs w0 x2 ; comment adjust virt disc addr, 1<23 is removed
al w2 x2+2 ; by integer overflow and b19(base) is added;
sh w2 x3 ;
jl. a1. ;
am e4+4 ;
sl. w2 g4. ;
jl. a2. ;
rl w2 x3-e4+18<1; comment adjust virt addresses
rl. w3 b14. ; in corutine table;
jl. a1. ;
a2: rl. w1 b19.+b20 ;
ws. w1 b19. ;
al w1 x1+2 ;
ls w1 -1 ; w1:= number of segments in disk core
rs. w1 b33. ; b33:= w1;
wa. w1 b32. ; w1:=no of segments;
ac w2 x1+1 ; w2:=-(no of segments+1);
sz w2 1 ; if odd then
al w2 x2-1 ; w2:=w2-1;
al. w3 (g4.) ; w2:=first byte in segmenttable
; note: indirect to enable tracing of external references
wa w2 x3+19<1 ; :=w2+addrof first semaphor;
\f
; rs 22.12.71 init, end pass central ...42...
al w0 -2 ; w0:=-2;
a3: am x1 ; while w1>0 do begin
hs w0 x2 ; segm table(w1):=w0;
al w1 x1-1 ; w1:=w1-1;
al w0 -1 ; w0:=-1;
sl w1 0 ; end;
jl. a3. ;
rs. w2 b23. ; b23:= start of segment table;
am. (b58.) ;
rl w3 j7 ;
al w3 x3+2 ; w1:= w2-(max core place-2)//512;
ls w3 -9 ;
al w1 x2 ;
ws w1 6 ;
rl. w3 b58. ; w3:=base of f-names;
rs w1 x3+j24 ; f24:=segment table base;
al w1 x2-8 ; -8 bytes = 2 entries
rs w1 x3+j9 ; f9:=last real entry of coretable;
e.
b. a10 w.
jl. a9. ;
a1: 0,0,0,0 ; name of bs-device for drumcore
a2: 0,0,0,0 ; - - - - - disccore
a3: e99. - h99 ;
a4: e100.- h99 ;
; j. code
a5: al. w1 a1. ;
al. w2 a3. ;
a6: wa w2 x2 ;
a7: rl w0 x2 ;
rs w0 x1 ;
al w1 x1+2 ;
al w2 x2+2 ;
sz w0 255 ;
jl. a7. ;
rl. w1 a2. ; w1:= first word of disccore bs-name
se w1 0 ; if w1<>0 then both names have been copied
jl. a8. ;
al. w1 a2. ;
al. w2 a4. ;
jl. a6. ;
a8: al w0 0 ;
al w2 0 ;
jl x3 ;
jl. a5. ;
j.
; end of j. code to include bs-devicename for drumcore and disccore
a9:
al w1 x2 ;
al. w0 b0. ;
ws w1 0 ; w1:= length of runtime core;
al w1 x1-4 ; dummy entry
al w0 0 ;
wd. w1 b46. ; w1:= w1//(512+4);
am. (g4.) ; note: indirect to enable tracing of external references
; ext(16):= number of core places;
rs w1 16<1 ;
ls w1 2 ;
ac w0 x1 ;
hs. w0 b54. ; set length in last entry;
al w1 x1+4 ;
ws w2 2 ;
sh. w2 (b45.) ; if first of core table<last of corut
jl. w3 c12. ; then goto init trouble;
rs w2 x3+f25-f0 ; w2:= f25:=
am. (g4.) ; note: indirect to enable tracing of external references
rs w2 156<1 ; ext(156):=
rs w2 x3+j21 ; f21:= first of core table;
rs w1 x3+f41-f0 ; core table length:= w1;
wm. w1 b61. ;
wd. w1 b62. ; search limit:= core table length
rs w1 x3+f42-f0 ; * fraction / 100;
\f
; rc 22.12.71 init, end pass central ...43...
al w2 x2+2 ;
dl. w1 b48. ; fill
a10: ds w1 x2 ; core table:= 0,4<12+4095;
al w2 x2+4 ;
sh. w2 (b23.) ;
jl. a10. ;
dl. w1 b54. ; set last entry;
ds w1 x2-4 ;
al. w1 (g4.) ; note: indirect to enable tracing of external references
rl w2 x1+18<1 ; w0:=coruno table start - pager;
al w0 x2-e12 ;
rs w0 x1+102<1 ; ext(102):= page descr;
rl w1 x1+20<1 ;
wa. w1 b30. ; w1:=sender table start + length;
rl. w2 b16. ;
sn w0 x2 ;
se w1 x2 ; if w0 or w1 <> post record of sender table then
jl. c22. ; goto init trouble;
rl w2 66 ;
dl w1 x2+74 ;
al. w3 b59. ; set base to
jd 1<11+72; boss max base;
dl. w3 a1.+2 ; move preferred
ds. w3 b32.+4 ; bs-device name
dl. w3 a1.+6 ; to tail
ds. w3 b32.+8 ;
rl. w3 b58. ; w3 := addr of f-names
al w3 x3+j26 ; w3 := addr of <:drumcore:>
al. w1 b32. ; w1:= tail addr;
rl w2 x1 ; w2:=size (in case of trouble);
jd 1<11+48 ; remove
jd 1<11+40 ; create
al w1 3 ;
jd 1<11+50 ; permanent(3);
jd 1<11+52 ; create area process
jd 1<11+8 ; reserve process
se w0 0 ; if result<>0 then
jl. c20. ; goto init trouble;
dl. w3 a2.+2 ;
ds. w3 b33.+4 ;
dl. w3 a2.+6 ;
ds. w3 b33.+8 ;
rl. w3 b58. ;
al w3 x3+f27-f26+j26; w3:=addr of<:disccore:>;
al. w1 b33. ;
rl w2 x1 ; w2:=size (in case of trouble);
jd 1<11+48 ;
jd 1<11+40 ;
al w1 3 ;
jd 1<11+50 ;
jd 1<11+52 ;
jd 1<11+8 ;
se w0 0 ;
jl. c21. ;
\f
; sm 75.06.06 init, end pass central ...43a...
al w2 -e5 ; w2 := rel first pre-external;
a0: al. w1 x2+g4. ; rep:w1 := abs external table part;
rl. w0 b67. ; w0 := 100 bytes, kind 14;
as w2 -1 ;
am. (b58.) ;
jl w3 +d37-f0 ; w2 output(ext table);
ls w2 1 ;
al w2 x2+100 ; increase part pointer;
sh w2 e4-2 ; if not all is output then
jl. a0. ; goto rep;
rl. w3 b58. ;
jl w2 x3+d36-f0 ; outblock;
rl. w3 b58. ; comment: this call forced a buffer change;
rl w1 x3+f34-f0 ; cyclestart := segment count ;
rs w1 x3+f47-f0 ;
jl. c1. ; goto next pass;
c8: al w0 1 ; reserve access(name table):
sl w1 (76) ; if process is not
sl w1 (78) ; area process then
jl x3 ; return;
ls w1 -1 ;
am. (b58.) ; access table(name table);
wa w1 f45-f0 ;
hs w0 x1 ;
jl x3 ; return;
e.
\f
; rc 26.2.71 init, end central ...44...
b. a50 w. b. a5, j5, m5 w.
j3: <:boss:>, 0, 0, 0 ; name of process, name table addr
c. e16 ; if monitor mode not wanted then include:
c.-e80
j4: 4 ; no of storage bytes to be changed in one pass of the
; message buffer code loop
; subroutine which changes the protection key of boss core area if boss is
; started in monitor mode.
;***** the code is transferred to a message buffer and executed there *****
; call:
; w0= new protection key
; w1= link
; link: last of boss own core
; link+2: return addr
; w2= base of first core addr to be changed
; w3= proc descr addr
m0: ks w0 x2+2 ;rep:
ks w0 x2+4 ; change protection key
al w2 x2+4 ; w2:=w2+4;
se w2 (x1) ; if w2 < last core then
jl. m0. ; goto rep;
jd. 2 ;
hs w0 x3+33 ; change pk in proc descr;
je w2 x1+2 ;
z.
z.
c11: ; end of initialize:
c. e7
al. w0 j1. ; write externals(fp mode):
am. (b55.) ;
jl w3 h31-2 ; outtext(<:externals:>);
al w1 -e5 ;
rs. w1 j0. ; ext := -e5;
a0: bl w0 2 ; rep:
wd. w1 j2. ;
se w0 0 ; if ext mod 20 <> 0 then
jl. a1. ; goto write;
al w2 10 ;
am. (b55.) ;
jl w3 h26-2 ; outchar(10);
rl. w0 j0. ;
as w0 -1 ;
am. (b55.) ;
jl w3 h32-2 ; outinteger (ext // 2);
1<23 + 32<12 + 4 ;
al w2 58 ;
am. (b55.) ;
jl w3 h26-2 ; outchar(58);
a1: rl. w1 j0. ; write:
rl. w0 x1+g4. ;
am. (b55.) ;
jl w3 h32-2 ; outinteger (word (ext));
1<23 + 32<12 + 9 ;
rl. w1 j0. ;
al w1 x1+2 ; ext := ext + 2;
rs. w1 j0. ;
sh w1 e4-2 ; if ext <= max then
jl. a0. ; goto rep;
al w2 10 ;
am. (b55.) ;
jl w3 h26-2 ; outchar(10);
jl. a2. ; exit;
\f
;kll 3.4.73 init, end central ...44a...
j0: 0 ; ext
j1: <:<10>externals<0>:>
j2: 20 ; constant
a2: ; exit addr:
z.
rl. w2 b58. ;
rl w1 x2+f35-f0+8;
jl. w3 c8. ; reserve access(bosstest);
rl w1 x2+j26+8 ;
jl. w3 c8. ; reserve access(drumcore);
rl w1 x2+f27-f0+8;
jl. w3 c8. ; reserve access(disccore);
al. w2 (g4.) ; note: indirect to enable tracing of external references
rl w1 x2+286<1 ;
jl. w3 c8. ; reserve access(usercat);
rl w1 x2+285<1 ;
jl. w3 c8. ; reserve access(catalog);
sp 66 ; if monitor mode then
sp. 0 ;
jl. 4 ;
jl. a3. ; begin
rl w3 66 ;
jd. 2 ; disable during name change;
dl. w1 j3.+2 ; process name:= boss;
ds w1 x3+4 ;
dl. w1 j3.+6 ;
ds w1 x3+8 ;
je. 2 ;
c. e16 ; if monitor mode not wanted then remove monitor mode:
c.-e80
al. w1 m0. ; w1:= mess addr;
al. w3 j3. ; w3:= addr of <:boss:>;
jd 1<11+16; send message to own process;
rl w3 66 ; w3:=proc descr addr;
rl. w1 b47. ; w1:=last of boss own core;
al w1 x1+2 ; correct for dummy word;
rs. w1 a5. ; save limit;
ws w1 x3+22 ; w1:=(last-first) of boss core;
al w0 0 ;
wd. w1 j4. ; w0:=remainder(w1 divided by 4);
ws. w0 j4. ; w0:=remainder - 4;
al w1 x2 ;
ws w1 0 ; w1:=buf addr + 2 + 4 - remainder;
rl w2 x3+22 ;
wa w2 0 ; w2:=first boss core + remainder - 4;
am. (g4.) ; note: indirect to enable tracing of external references;
rl w0 -11<1 ; w0:=ext(-11); (i.e. pk);
jl w1 x1+8-2 ; jump to message (rel: 4 - remainder);
a5: b47+2 ;+2 last boss core addr;
; at return from the procedure the protection key of whole boss core is changed,
; but the registers may have their old pk. therefore :
al. w1 ; here ; call some proc func procedure
al. w3 ; here ; in order to force pk-change
jd 1<11+40; of working registers;
; now boss is running in normal task mode;
al w2 x2-16-8 ; w2:=buffer address;
jd 1<11+82; regret message;
z.
z.
c.e80
rl w3 66 ; w3:=own process description
dl w1 x3+24 ; w01:=own core limit
rl w2 x3+100 ; w2:=lower write limit
se w0 x2 ; if lower write limit < first core then
ds w1 x3+102 ; set limit registers
z.
a3: am. (b58.) ; end;
jl d12-f0 ; goto wait;
e. ;
\f
; rc 11.01.72 init, alarms central ...45...
c12: ds. w1 a16. ; init trouble:
jl. a2. ; alarm:= a22;
c13: ds. w1 a16. ;
jl. a3. ; alarm:= a23;
c14: ds. w1 a16. ;
jl. a4. ; alarm:= a24;
c15: ds. w1 a16. ;
jl. a5. ; alarm:= a25;
c16: ds. w1 a16. ;
jl. a6. ; alarm:= a26;
c17: ds. w1 a16. ;
jl. a7. ; alarm:= a27;
c18: ds. w1 a16. ;
jl. a8. ; alarm:= a28;
c19: ds. w1 a16. ;
jl. a9. ; alarm:= a29;
c20: ds. w1 a16. ;
jl. a10. ; alarm:= a30;
c21: ds. w1 a16. ;
jl. a11. ; alarm:= a31;
c22: ds. w1 a16. ;
jl. a14. ; alarm:=a32;
c23: ds. w1 a16. ;
jl. a1. ; alarm := a33;
c24: ds. w1 a16. ;
jl. a19. ; alarm:=a34;
a2: am a21 ;
a3: am a21 ;
a4: am a21 ;
a5: am a21 ;
a6: am a21 ;
a7: am a21 ;
a8: am a21 ;
a9: am a21 ;
a10: am a21 ;
a14: am a21 ;
a1: am a21 ;
a19: am a21 ;
a11: al. w0 a31. ;
d27: ; init alarm: w0 = text addr; text = 11 words exactly.
ds. w3 a18. ;
c.e7,am. (b55.) ; if fp mode then
jl w3 h31-2 z. ; outtext(alarm)
c.-e7,al w1 a20 ; else
wa w1 0 ; begin
ds. w1 b42. ; b41,b42:= addr alarm text;
a12: al. w1 b40. ; rep:
rl. w3 b58. ; send message(main console);
al w3 x3+j16 ; if no buffers then
jd 1<11+16 ; begin
se w2 0 ; wait event;
jl. a13. ; get event;
jd 1<11+24 ; goto rep;
jd 1<11+26 ; end;
jl. a12. ; wait answer;
a13: jd 1<11+18 ; end;
z. dl. w3 a18. ;
dl. w1 a16. ; reestablish registres;
c.-1, o5, z. ; (bossfault xref)
jd -5 ; alarm;
\f
; rc 26.2.71 init, alarms central ...46...
a15: 0, a16: 0, a17: 0, a18: 0 ; saved registers
a22: <:<10>process too small <10><0>:>
a23: <:<10>corutine area missing <10><0>:>
a24: <:<10>dummy answer corutine <10><0>:>
a25: <:<10>transfer error corutine <10><0>:>
a26: <:<10>max corutine too small <10><0>:>
a27: <:<10>input error virt core <10><0>:>
a28: <:<10>output error virt core <10><0>:>
a29: <:<10>virt core table too small <10><0>:>
a30: <:<10>create drum core error <10><0>:>
a32: <:<10>table reservation error <10><0>:>
a33: <:<10>i116 too small: w0=min value <10><0>:>
a34: <:<10>external outside limits <10><0>:>
a31: <:<10>create disc core error <10><0>:>
a21= a22-a23 ; -length of alarm text
a20= a23-a22-2 ; length of alarm text-2
e.
\f
; rc 10.11.71 init, load list central ...47...
b. a9 w. ;
g0: <:bterm2:>,0,0,0 ; first corutine file: (5 word entries)
<:bterm1:>,0,0,0 ; after bterm1 (termout)
<:bjobstart:>,0,0 ; after bterm1
<:bjob:>,0,0,0 ;
<:bmount:>,0,0,0 ;
<:bread:>,0,0,0 ;
<:bprinter:>,0,0 ; fills holes
<:bprocs:>,0,0,0 ; last sender description
<:bbanker:>,0,0 ; last file. cleans catalog
g1=k-9 ; lastname+1:
g2: 0 ; next name:
c.-e7
g8: rl w3 66 ; move program:
rl w3 x3+22 ; w3:= first of process;
am -2000 ;
rl. w2 b58.+2000; w2:= first of program;
a1: dl w1 x2+2 ;
ds w1 x3+2 ;
al w2 x2+4 ; move program to
al w3 x3+4 ; first of process;
sh. w3 g8. ;
jl. a1. ;
ws w3 4 ;
am -2000 ;
jl. x3+g9.+2000; return;
z.
g7:
g4=k+e5
g5=g4+e4, g6=g5+4 ; start of external table
g10=g5-b0 ; length of init
f40=g5 -f0 ; length of resident part+init
f30=b0-f0 ; length of resident part
; end init code= start ext table+ length of ext table;
e.e. ; end b-names and j-names
f48=s0, f49=s1 ; final checksum
i.e. ; end c names and g-names
i.e. ; end d-names and f-names
e. ; end options (i and e-names)
e.e. ; end h-names and dummy block ; end fp-names
▶EOF◀