|
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: 110592 (0x1b000)
Types: TextFile
Names: »tprocs«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦0b92c64d5⟧ »ctb«
└─⟦this⟧
(bprocs = set 1 disc
bprocs = slang proc.options proc.jobdescr
scope user bprocs
print bprocs integer words.4 0.6
)
b. w.
p.1
; kll 19.11.71 boss 2,account ...1...
s0=0, s1=1 ;
s. h12 w. ;
h11, h12 ;
78 05 02 , 82 ; version id:
m. boss 2 tprocs
;bprocs creates the following boss2-codepages:
; -account- , -bsadjust- , -initialize from usercat-
;and -unknown sender- .
s. b50, g20 ,c9 w. ;
b. f12 w. ;
b. a20 w. ;
b1., b2., b3., b4., b5., b6., b7., b8., b9.
b23.,b24.,b25.,b26., b27., b28., b29., b31.,b32.,b33.,b34.
b35.,b36.,b37.,b38.,b39.,b40.,b45.
f0., f1., f2., f5., f7., f8., f12.
h1:h2 ;end external list
jl. a0. ;
f0: 0 ; base of external table
f1: 12 ; reserve virt
f2: 13 ; move to virt
f3: 1000000 ;
f4: 0 ; created
f6: 0, 0 ; time on account file
f7: 15 ; end init
f8: 31 ; init alarm
; f9, f10
f11: i105*16 - i14 ; total accounts
f12: 288 ; slice length on disc
a0: al w0 i12 ; virt account buf on disc;
al w1 512 ; length;
jl. w3 (f1.) ; reserve virt;
al w2 x2+1 ; add writing;
rs. w2 b10. ; b10:= virt account buf;
al w0 i13 ; account code on disc;
al w1 g5 ; length;
jl. w3 (f1.) ; reserve virt;
al w2 x2+1 ; add writing;
rs. w2 b11. ; b11:= virt account code;
dl. w1 b11. ;
rs. w0 b42. ;
rs. w1 b43. ;
jl. w2 c2. ; set base(boss priv);
\f
; kll 19.11.71 boss 2, account ...2...
al. w0 g4. ; bufbase:= g4.;
rs. w0 f9. ;
al w0 0 ;
al w1 i105 ; if length of accountfile is not
wd. w1 f12. ; a multiplum of the slice length then
se w0 0 ; goto error;
jl. a14. ;
al. w3 b22. ;
al. w1 b17. ;
jd 1<11+42; lookup(account file);
rl. w1 b17. ; release:= segments *
wm. w1 b19. ; records per segment;
rs. w1 b18. ;
al w0 i105 ;
wa. w0 f12. ;
ws. w0 b17. ; length:= account file segments -
rs. w0 b17. ; length of account file + spare;
sh w0 0 ; if length <= 0 then
jl. a8. ; goto create error;
jd 1<11+36; set short clock
ld w1 5 ;
rs. w0 b44. ; in entry
al. w1 b17. ;
al. w3 b21. ;
jd 1<11+40; create(accountf1);
rs. w0 f4. ; created:=result;
jd 1<11+44; change entry;
se w0 0 ; if not ok then
jl. a8. ; goto create error;
al w1 3 ;
jd 1<11+50; permanent accountf1.3;
jd 1<11+52; create area process;
jd 1<11+8 ; reserve accountf1;
se w0 0 ; if not reserved then
jl. a9. ; goto reserve error;
rl. w0 f4. ;
se w0 0 ; if created then
jl. a1. ; begin
jl. w1 c3. ; insert end record;
jl. w3 c1. ; write;
a1: ; end;
al w0 3 ; code:= input;
hs. w0 b15. ;
a2: jl. w3 c1. ; rep segment:
; read;
a3: al. w3 g4. ; rep record:
wa. w3 b14. ; w3:= record(index);
rl w0 x3+10 ;
sn w0 99 ; if kind = end then
jl. a5. ; goto exit;
sh. w0 (b30.) ; if kind > last private kind or
sh w0 0 ; kind < 1 then
jl. a4. ; goto error;
\f
; kll 19.11.71 boss 2, account ...3...
rl w0 x3+0 ;
sl w0 1 ; if project number < 1 or
sl. w0 (f3.) ; project number > 999999 then
jl. a4. ; goto error;
dl w1 x3+14 ;
rx. w0 f6. ; if clock(record) < clock
rx. w1 f6.+2 ; then goto error;
ss. w1 f6.+2 ;
sl w0 0 ; clock:= clock(record);
jl. a4. ;
rl. w1 b14. ;
wa. w1 b20. ; index:= index + length;
rs. w1 b14. ;
sh w1 15*32 ; if index <= last then
jl. a3. ; goto rep record;
rl. w1 b16. ;
al w1 x1+1 ; segment:= segment + 1;
rs. w1 b16. ;
al w0 0 ;
rs. w0 b14. ; index:=0;
jl. a2. ; goto rep segment;
a4: al w0 0 ; error:
rs. w0 b14. ; index:= segment:= 0;
rs. w0 b16. ;
al w0 5 ;
hs. w0 b15. ; code:= output;
jl. w1 c3. ; insert end record;
jl. w3 c1. ; write;
a5: al w0 5 ; exit:
hs. w0 b15. ; code:= output;
jd 1<11+36; get clock;
ss. w1 f6.+2 ; if current clock < last account clock then
sh w0 -1 ;
jl. a11. ; goto error;
rl. w2 b16. ;
wm. w2 b19. ; w2:= segments * records per segment;
rl. w1 b14. ;
al w0 0 ;
wd. w1 b20. ; w1:= index / record length;
wa w2 2 ;
wa. w2 b18. ;
al w1 x2 ; w1:= used - total accounts;
ws. w1 f11. ;
sh w1 0 ; if w1 > 0 then
jl. a10. ; begin
ws w2 2 ; w2:= w2 - w1;
rl. w0 b18. ; comment w2:= total;
ws w0 2 ; release:= release - w1;
rs. w0 b18. ; end;
a10: rs. w2 b41. ;
jl. w3 (2) ; set externals;
f5: 40 ;
b41: 0 , 430 ; used accounts;
g0 , 431 ; rel outrec;
g1 , 432 ; rel prepare;
g2 , 433 ; rel private;
g3 , 434 ; rel terminate;
b42: 0 , 435 ; virt account buf;
b43: 0 , 436 ; virt code;
0 , -1000 ; end of externals;
\f
; kll 19.11.71 boss 2, account ...4...
al. w0 g4. ; w0:= start virt buf;
al w1 512 ; w1:= length;
rl. w2 b10. ; w2:= ref virt;
jl. w3 (f2.) ; move to virt;
al. w0 b0. ; w0:= start code;
al w1 g5 ; w1:= length;
rl. w2 b11. ; w2:= ref virt;
jl. w3 (f2.) ; move to virt;
jl. (f7.) ; goto end init;
a13: <:<10>i105 not mult of slice length <10><0>:>
a12: <:<10>time inconsistence accountf1 <10><0>:>
a6: <:<10>create accountf1 error <10><0>:>
a7: <:<10>reserve accountf1 error <10><0>:>
a14: am a13-a12; accountfile length error:
a11: am a12-a6 ; time inconsistence error:
a8: am a6-a7 ; create error:
a9: al. w2 a7. ; w0:= text addr;
rx w2 0 ; w2:= cause(monitor result);
jl. w3 (f8.) ; goto init alarm;
e. ;
\f
; kll 19.11.71 boss 2, account ...5...
b0: 0, r.5 ; abs page addresses
80<12 + 0 ; page ident: account
b1: 3 ; lock
b2: 4 ; open
b3: 8 ; page jump
b4: 25 ; call
b5: 26 ; current corutine
b6: 320 ; io point
b7: 321 ;
b8: 417 ; finis(finis cause) point
b9: 427 ;
b10: 0 ; virt account buf
b11: 0 ; outrec account point
b12: g0 ;
b13: 0 ; constant 0
b14: 0 ; index
b15: 5<12, 0, 0 ; output message
b16: 0 ; segment
b17: 0,<:disc:>, 0,r.7 ; work(tail)
b44=b17+10 ; short clock
b18: 0 ; release
b19: 16 ; records per segment
b20: 32 ; record length
b21: <:accountf1:>,0,0 ;
b22: <:accountfile:> ;
b30: 999999 ; last private kind
b33: 74 ; catalock;
b45: 288 ; slice length on disc
; formats:
;
; procedure outrec account
; page 1: +0, +2 return
; +4 kind
; +6 param1
; +8 param2
; +10,+16 user name
; +18 project number
; +20 paper type for print records
; format of account record:
; +0 project number 0<p<1000000
; +2,...+8 user name
; +10 kind 0<k<1000000
; +12,+14 time accounted ascending
; +16 param1
; +18 param2
; +20, +30 finis params
;
; finis: kind = 1, param1 = used time, param2 = mounts, tapes
; cpu > 13, temp drum, disc , stat, size , device word 1, device word 2
; waiting time, conversational input lines
; logout: kind = 2, param1 = login time, param2 = operations
; print: kind = 3, param1 = lines , param2 = pages , paper type
; private: kind >99, param1 = m+14, param2 = unused
;
; end record: kind = 99
; login time is in min, used time is in sec
\f
; kll 19.11.71 boss 2, account ...6...
b. a5, j9 w. ;
g0=k-b0 ; outrec account:
rl. w2 b0.+6 ;
wa. w2 b14. ; w2:= abs ref record(index);
dl w1 x3+8 ;
ds w1 x2+18 ; record(16:18):= param1:2;
jd 1<11+36;
ds w1 x2+14 ; record(12:14):= get clock;
dl w1 x3+16 ;
ds w1 x2+8 ; record(2:8):= user name;
dl w1 x3+12 ;
ds w1 x2+4 ;
dl w1 x3+20 ;
rs w1 x2+20 ; record(20):= paper type (or param 3);
rs w0 x2+0 ; record(0) := project number;
rl w1 x3+4 ;
rs w1 x2+10 ; record(10):= kind;
se w1 1 ; if end job record then
jl. a0. ; begin
j0: rl w0 x3+501 ; record(20):= cpu used(d79);
j1: rl w1 x3+502 ; record(22):= temp drum, disc(d85);
ds w1 x2+22 ;
j2: bz w0 x3+503 ; record(24):= stations(d49);
hs w0 x2+24 ;
j3: rl w1 x3+504 ;
j4: ws w1 x3+505 ; record(25):= size in segments:=
al w1 x1+511 ;
ls w1 -9 ; (top addr - first addr)//512;
hs w1 x2+25 ;
j5: dl w1 x3+340 ; record(26):= device word 1;
ds w1 x2+28 ; record(28):= device word 2(d30);
rl w1 x3+20 ; record(30):=waiting time,
rs w1 x2+30 ; conversational input lines;
a0: rl. w1 b14. ; end;
wa. w1 b20. ; index:= index + length;
rs. w1 b14. ;
jd-1
sh w1 32*15 ; if index > last then
jl. a1. ; begin
jl. w3 c1. ; write;
rl. w1 b16. ;
al w1 x1+1 ; segment:= segment + 1;
rs. w1 b16. ;
al w1 0 ; index:= 0;
rs. w1 b14. ; end;
a1: jl. w1 c3. ; insert end record;
rl w1 x3+4 ;
rl. w0 b14. ;
sl w1 100 ; if kind internal then
sn w0 0 ; or index = 0 then
jl. w3 c1. ; write;
c0: ; return:
rl. w1 (b5.) ;
rl. w3 b0.+2 ;
al w0 0 ;
rs w0 x1+12 ; page 3:= 0;
dl w3 x3+2 ;
jl. (b3.) ; page jump(return);
b35=j0+1, b36=j1+1, b37=j2+1, b38=j3+1, b39=j4+1, b40=j5+1
e. ;
\f
; kll 19.11.71 boss 2, account ...7...
b. a1 w.
g1=k-b0 ; prepare account:
rl. w2 b33. ;
jl. w3 (b1.) ; lock(catalock);
al w0 i14-2 ; rest accounts:= accounts free
b27=k+1 ; to private accounts;
hs w0 x3+345 ;
jl. w3 c1. ; write;
jl. w2 c2. ; set base;
al. w3 b21. ; old name:= accountf1;
al. w1 b22. ; new name:= accountfile;
jd 1<11+46; rename(accountf1, accountfile);
rl. w3 b0.+2 ;
se w0 0 ; if not ok then
jl. a1. ; goto return;
rl. w2 b16. ;
wm. w2 b19. ; w2:= segment * records
rl. w1 b14. ; per segment;
al w0 0 ;
wd. w1 b20. ; w1:= index / record length;
wa w2 2 ;
b34=k+1 ;
bs w2 x3+347 ;
rs. w2 b18. ; release:= w2 + w1 - converts;
rl. w1 b16. ;
al w1 x1+1 ; length(accountfile):=segment+1;
rs. w1 b16. ;
jd 1<11+36; set short clock
ld w1 5 ;
rs. w0 b16.+10; in entry
al. w1 b16. ; w1:= abs ref tail;
al. w3 b22. ; w3:= abs ref account file;
jd 1<11+64; remove area process(accountfile);
jd 1<11+44; change entry;
jd 1<11+42; lookup entry;
al w0 i105 ;
wa. w0 b45. ;
ws. w0 b16. ; length:= account file segments
rs. w0 b16. ; - length of account file;
al. w3 b21. ;
jd 1<11+40; create(accountf1);
al w1 3 ;
jd 1<11+50; permanent accountf1.3;
jd 1<11+52; create area process;
jd 1<11+8 ; reserve process;
se w0 0 ; if not ok then
c.-1, o88, z. ; (bossfault xref)
jd -88 ; boss fault 88;
al w0 0 ;
rs. w0 b14. ; index:= 0;
rs. w0 b16. ; segments:= 0;
jl. w1 c3. ; insert end record;
jl. w3 c1. ; write;
a1: rl. w2 b33. ;
jl. w3 (b2.) ; open(catalock);
jl. c0. ; goto return;
e.
\f
; kll 19.11.71 boss 2, account ...8...
b. a5, j9 w. ;
g2=k-b0 ; private account:
rl. w2 b0.+8 ;
rl w2 x2+4 ; kind:= m + 12;
dl w1 x2+18 ; param 2 := m+8;
rs w0 x3+8 ; param 3 := m+10;
rs w1 x3+20 ;
dl w1 x2+22 ; param1:= m + 14;
ds w1 x3+6 ;
sh. w0 (b30.) ; if kind > last kind or
sh w0 99 ; kind < 100 then
jl. a1. ; goto unintelligible;
j1: bz w1 x3+345 ;
al w1 x1-1 ;
sh w1 -1 ; if rest account-1 <0 then
jl. a2. ; goto finis;
j2: hs w1 x3+345 ; rest accounts:=rest accounts-1
j4: al w2 x3+326 ;
dl w1 x2-8 ; move job name to
ds w1 x3+12 ; page 1 +10, +16;
dl w1 x2-4 ;
ds w1 x3+16 ;
j6: rl w0 x3+326 ; +18:= project number
rs w0 x3+18 ;
rl. w1 (b5.) ;
rl. w0 b10. ;
rs w0 x1+12 ; page 3:= virt account buf;
dl. w3 b12. ;
jl. w1 (b4.) ; call outrec account;
am -2 ; result:= normal answer;
a1: al w0 3 ; unintelligible:
rl. w1 (b5.) ; result:= unintelligible;
j7: rl w2 x3+338 ;
rs w2 x1+8 ; page1:=jobfilepage
al w2 0 ;
rs w2 x1+14 ; page 4:= 0;
rl. w1 b0.+8 ;
rx w2 x1+4 ; message(sender table):= 0;
al. w1 b13. ;
jd 1<11+22; send answer(result);
dl. w3 b7. ;
jl. (b3.) ; page jump(io);
a2: al w0 17 ; finis:
j3: hs w0 x3+339 ; finis cause:= accounts exceeded;
dl. w3 b9. ;
jl. (b3.) ; page jump(finis(finis cause));
; call w2 = link
c2: rl w1 66 ; set base:
rl w1 x1+76 ; comment boss private base;
al w0 x1 ; w0:= w1:= boss max base low limit;
al. w3 b13. ; w3:= abs ref 0;
jd 1<11+72; set base(w0, w1);
rl. w3 b0.+2 ; w3:= abs ref page 1;
jl x2 ; goto return;
b24=j1+1, b25=j2+1, b26=j3+1, b29=j4+1, b31=j6+1, b32=j7+1
e. ;
\f
; kll 19.11.71 boss 2, account ...9...
b. a5, j5 w. ;
g3=k-b0 ; terminate account:
; comment the accountjob must release the following number
; of accounts:
; accounts in file - (converts - rest converts) - (accounts
; - rest accounts) - 2
rl. w2 b33. ;
jl. w3 (b1.) ; lock(catalock);
jl. w2 c2. ; set base;
al. w1 b17. ;
al. w3 b22. ; w3:= abs ref account file;
jd 1<11+42; lookup entry;
sn w0 0 ; if not ok then
jl. a1. ; begin
al w0 i105 ; length:= account file
rs. w0 b17. ; segments;
jd 1<11+36; set short clock
ld w1 5 ;
rs. w0 b44. ; in entry
al. w1 b17. ;
al. w3 b21. ; w3:= abs ref accountf1;
jd 1<11+44; change entry;
rl. w3 b0.+2 ;
rl. w1 b18. ; release account:= release
b23=k+1 ;
ba w1 x3+345 ; + rest accounts -
al w1 x1-i14 ;
b28=k+1 ; max accounts used by accountjob;
hs w1 x3+345 ;
a1: rl. w2 b33. ; end;
jl. w3 (b2.) ; open(catalock);
jl. c0. ; goto return;
e. ;
; call: w3 = link, exit: w3 = page 1
c1: rs. w3 b17.+18; write:
rl. w3 b0.+6 ; first addr:= page 3;
al w0 x3+510 ; last addr:= first addr + 512;
ds. w0 b15.+4 ;
al. w1 b15. ; w1:= ref message;
al. w3 b21. ; w3:= ref accountf1;
jd 1<11+16; send message;
al. w1 b17. ;
jd 1<11+18; wait answer;
al w2 1 ;
ls w2 (0) ; w2:=result;
al w0 x2 ;
sn w0 1<1 ; if normal answer then
lo w0 x1 ;
se w0 1<1 ; w0:=logical status;
c.-1, o80 , z. ; bossfault xref
jd -80 ; alarm;
rl. w3 b0.+2 ; w3:= abs ref page 1;
jl. (b17.+18); goto saved return;
; call w1 = link
c3: rl. w2 b0.+6 ; insert end record:
wa. w2 b14. ; record(index).kind:=
al w0 99 ; end;
rs w0 x2+10 ;
jl x1 ; goto return;
g4: g5=g4-b0 ; length
f9 = b0 +6
e.i.
e.
\f
; boj 30.8.71 boss 2, bs adjust, ...10...
; the slang conditions in bsadjust are the following:
; c. i27: drum exists. if drum exists the main catalog will be on the
; drum, and there is an auxiliary device called <:disc:>,
; which is used as system device. else there is only one
; system device, which will be called <:disc:>, and which
; contains the main catalog.
; c. i30-1: private kits exist.
; c. i30+i27: some auxiliary-catalog device exist.
; initialization
s.b50 ;global variables and constants
c10 ;routines
f15 ;initialization names
g25 ;external displacements
j25 ;
w. h2=h1. ;start external list:
; external list
b1.,b2.,b3.,b4.,b5.,b6.,b8.
b9.,b15.,b16.,b50.
f0.,f1.,f2.,f3.,f4.
g11.,g12.,g16.,g21.,g22.,g23.
c.i27,g4.,g5.,g9.,g10.,g14.,g18.,g19.,g20. z.
c.i30-1,g0.,g13.,g17. z.
c.i27+i30,g1.,g2.,g3.,g7. z.
h3: h4 ; end external list
b. w. ;
; reserve virtual:
al w1 f5 ; w1:= length of page 0;
al w0 i28 ; w0:= drum or disc;
jl. w3 (f1.) ; reserve virtual(w0, w1), virt ref page 0: (w2);
al w2 x2+1 ; put on writing bit;
; initialize externals: w2 = virt ref page 0.
rs. w2 b17. ;
rs. w2 f11. ; ext(415);
al w0 f6 ;
rs. w0 b18. ; rel ref prepare;
rl. w0 b4. ;
rs. w0 f12. ; ext(74);
jl. w3 (2) ; set externals;
f4: 40 ;
f11: 0 , 415 ; virt ref page 0;
f6 , 413 ; rel ref prepare;
f8 , 428 ; rel ref transfer permclaims;
f7 , 414 ; rel ref terminal;
f12: 0 , 74 ; abs ref catalock;
0 , -1000 ; end of externals;
al w0 1 ;
rs. w0 (b4.) ; catalock:=1
; move to virtual: w1 = length of code, w2 = virt ref page 0.
al. w0 b0. ; w0:= abs ref page 0;
jl. w3 (f2.) ; move to virt(w0, w1, w2);
am.(4,jl.4,h1.) ; goto initialize account
e.
\f
; boj 5.1.72 boss 2, bs adjust, ...11...
; variables used by initialization
f0: 0 ; base externals
f1: 12 ; ref reserve virt
f2: 13 ; ref move to virt
f3: 15 ; ref end init
;f5= f4-b0 ; length of code
;f6= c0-b0 ; rel ref prepare
;f7= c1-b0 ; rel ref terminate
;f8= c6-b0 ; rel ref transfer
;
; variables and constants used by code
b0: 0 ; page0: codes and variables
0 ; page1: unused
0 ; page2: unused
0 ; page3: usercat buffer = ext(416)
0 ; page4: job description
81<12 + 0 ; page ident: bsadjust
b2: 2 ; send and wait fast
b3: 3 ; lock simple
b4:e13<12+19 ; catalock semaphore
b5: 75 ; reserve usercat semaphore
b6: 4 ; open simple
b8: 8 ; page jump
b9: 25 ; call
b15: 416 ; virt ref buffer
b16: 26 ; ref ref own description
b17: 0 ; virt
b18: 0 ; rel ref prepare bs adjust
b28: h. 0 ; mente
b29: 0 ; counter for claims exceeded
b7: 0 ; mask
b10: 0 ; shiftmask
b31: 0 ; usercat segm writing bit
b36: 0 w.; claims exceeded
0, 0 ;b27-4: usercat ref, page 4 ref (in c7)
b27: 0 ; save ref old (in c2) save return from c7 and c8
b20: 0, r.i29*4 ; save claims on unknown kits
b30: 0, r.i29*4 ; b20+i29*4: save oldclaims
b32: 0
0 ; save return from c6
0 ; b33-2: return from c5
b33: 0 ; save w0 in c5
b37: 0,0,0,0 ; monitorclaims,key=0,1,2,3
b38: 0,0,0,0 ; docname(docindex)
b35: 0 ; save docindex
0 ; b35+2: save w3 from c4
c. i30-1
b39: 0 ; kittable index
z.
b40: 0,0,0,0 ; restclaims
b45: 0 ; new usercat segm, rel
b41: 0 ; save page 3
b42:c.i27,<:drum:>,0,0 ;
b43:z. <:disc:>,0,0 ;
b46: 0 ; output from c5, get rest3 from usercat
b47: 0,0,0,0 ; message to usercat
b48: <:usercat:>,0,286; name,name table address
b49: 0 ; return from c2,translate and c4,get claims
b50: 21 ; privout
b1 = b48+8 ; name table address usercat
\f
; boj 30.8.71 boss 2, bs adjust, ...12...
; routines:
; c0 prepare
; c1 terminate
; c2 translate
; c3 test names
; c4 get monitorclaims
; c5 get usercat segment
; c6 transfer and prepare
; c7 compare
; c8 strange maincat entries
; c9 adjust rest 3
;
; procedure prepare bs adjust
; ===========================
; abstract:lock(catalock)
; for docindex:=ref drumtable step 2 until top_bs_table-2
; do begin get monitorclaims;save claims end
;
b.a5 w. ;
c0: rl. w2 b4. ; w2:=ref catalock;
jl. w3 (b3.) ; lock(w2);
ld w1 -100 ;
al. w3 b20. ; clear claims on unknown kits
a2: ds w1 x3+2 ;
al w3 x3+4 ;
se. w3 b30. ;
jl. a2. ; index:=base oldclaims;
rl w2 92 ; docindex:=drumtable;
a0: sn w2 (96) ; rep: if docindex=top bs table
jl. a1. ; then goto return;
jl. w1 c4. ; get monitorclaims;
dl. w1 b37.+2 ;
ds w1 x3+2 ;
dl. w1 b37.+6 ;
ds w1 x3+6 ; oldclaims(index):=monitorclaims;
al w3 x3+8 ; index:=index+8;
al w2 x2+2 ; docindex:=docindex+2;
jl. a0. ; goto rep;
;return:
a1: rl. w3 b0.+2 ; w3:=ref page 1;
dl w3 x3+2 ; w2w3:=ref return;
jl. (b8.) ; page jump (return);
e.
\f
; boj 30.8.71 boss 2, bs adjust, ...13...
; procedure get monitor claims
; ============================
; call return
; w0 undef
; w1 link undef
; w2 docindex unch
; w3 unch
; b35 docindex
; b37 claims
; b38 docname
;
; the format of the monitors claims are the following:
;
; 66: process description
; 92: drumtable
; 96: table end
; drumtable: slicelist 0
; : slicelist 1
; ..... : ...
; table end: 0
;
; slicelist i -36: rel ref claims
; -18: doc name
; -8 : slice length
; -4 : auxiliary catalog, -
;
; proc desc+rel ref claims:entries<12+slices(key=0,1,2,3)
b. a1 w. ;
c4: ds. w3 b35.+2 ; save w2w3;
rs. w1 b49. ; save w1;
rl w3 x2+0 ; w3:= slicelist;
dl w1 x3-18+2 ; move docname
ds. w1 b38.+2 ;
dl w1 x3-18+6 ;
ds. w1 b38.+6 ; to b38;
rl w2 x3-36 ; w2:= proc descr rel ref claims;
wa w2 66 ; w2:= abs ref claims;
dl w1 x2+2 ; begin move claims
ds. w1 b37.+2 ; to b37;
dl w1 x2+6 ;
ds. w1 b37.+6 ;
c. i27+i30
c. 2-e79
bl w0 x3-4 ; if auxiliary catalog
se w0 -1 ; then
z.
c. e79-3
sn w3 (98) ; if not maincat device then
z.
jl. a0. ;
bl. w0 b37.+4 ; key 2 entries
hs. w0 b37.+2 ; := key 1 entries
hs. w0 b37.+0 ; := key 0 entries;
a0: z. ; end;
rl. w1 (b16.) ;
bz w0 x1+4 ; if test 2 then
so w0 2 ;
jl. a1. ;
al. w1 b37. ;
al w0 18<6+16;
jl. w3 (b50.) ; privout b37;
a1: dl. w3 b35.+2 ; restore w2w3;
jl. (b49.) ; return;
e. ;
\f
; boj 30.8.71 boss 2, bs adjust, ...14...
; procedure test name
; ===================
; call return
; w0 undef
; w1 undef
; w2 ref name unch
; w3 link abs ref page 4
; b38 ref doc name unch
b. a3 w. ;
c3: rs. w3 b33. ; save return;
rl. w3 b0.+8 ; w3:= abs ref page 4;
dl w1 x2+2 ; w0w1:= first 6 chars;
sn. w0 (b38.) ; if
se. w1 (b38.+2); any difference
jl. a0. ; then return to link+2
dl w1 x2+6 ; else w0w1:= last 6 chars;
sn. w0 (b38.+4); if still no difference
se. w1 (b38.+6);
jl. a0. ; then return to link+ 2
jl. (b33.) ; return to link
a0: rl. w1 b33. ;
jl x1+2 ;
e. ;
; procedure terminate bs adjust
; =============================
; page4=jobdescription
; abstract:
; claims exceeded:= false;
; lock(reserve usercat);
; drumentries(1):=drumentries(1)+strange maincat entries
; docindex:= drumtable;
; rep1: if docindex = top bstable then goto end1;
; get monitorclaims(docindex);
; if name = <:drum:> then goto drum;
; if name = <:disc:> then goto disc;
; kitindex:= first in kittable;
; rep2: if kitname(kitindex)=0 then goto unknown kit
; if name = kitname(kitindex) then goto private_kit;
; kitindex:= kitindex + kittable entry length;
; goto rep2;
;
; step_docindex: docindex:= docindex + 2; goto rep1;
;
; end: drumentries:=drumentries-strange maincat entries
; terminate usercat;
; open(reserve usercat);
; if claims exceeded then error return;
; open(catalock);
; normal return;
;
; unknown kit: drum: disc: private_kit: get bossclaims; update claims; put claims;
; goto step_docindex;
\f
; boj 5.1.72 boss 2, bs adjust, ...15...
; terminate bs adjust
b. a8 w. ;
c1: ac w1 1 ;
rs. w1 b47.+6 ; current segment:= -1;
al w0 0 ; w0:= 0;
hs. w0 b36. ; claims exceeded:= false;
rl. w1 (b16.) ; w1:= ref own corutine description;
rl. w0 b15. ;
rx w0 x1+12 ; page 3:=usercat buffer
rs. w0 b41. ; save old page 3
rl. w2 b5. ; w2:= abs ref reserve usercat;
jl. w3 (b3.) ; lock(w2); (w3:= abs ref page 1);
c.i27+i30
jl. w3 c8. ; drumentries:=drumentries
c.i27
j1: ba w0 x3+412 ; +strange maincatentries
j2: hs w0 x3+412 ;
z.c.-i27
j1: ba w0 x3+410 ;
j2: hs w0 x3+410 ;
z.
z.
rl w2 92 ; for docindex:= drumtable
a0: sn w2 (96) ; until top bs table - 2
jl. a1. ; do begin
ld w1 64 ;
ds. w1 b40.+2 ; rest 0,1:=0
ds. w1 b40.+6 ; rest 2,3:=0
jl. w1 c4. ; get monitorclaims(docindex); save docindex;
al. w2 b42. ; w2:= abs ref<:drum:>;
jl. w3 c3. ; if name = <:drum:> (w3:= abs ref page 4)
jl. a2. ; then goto drum;
c.i27
al. w2 b43. ; w2:= abs ref<:disc:>
jl. w3 c3. ; if name = <:disc:> (w3:= abs ref page 4)
jl. a3. ; then goto disc;
z.
c.i30-1
j0: al w1 x3+403 ; kitindex:= first in kittable;
a4: rl w0 x1+0 ; if kitname = 0 then
sn w0 0 ; goto unknown kit;
jl. a8. ;
rs. w1 b39. ; save kitindex;
al w2 x1+0 ; w2:= abs ref kit name;
jl. w3 c3. ; if name = kitname (w3:= abs ref page 4)
jl. a5. ; then goto private kit;
al w1 14 ; kitindex:=entry length
wa. w1 b39. ; + kitindex;
jl. a4. ; goto rep;
z.
; step docindex:
a6: al w2 2 ; docindex:= docindex + 2;
wa. w2 b35. ;
jl. a0. ; end;
\f
; boj 30.8.71 boss 2, bs adjust, ...16...
a1:
; end:
c.i27+i30
jl. w3 c8. ; drumentries
ac w0 (0) ; :=drumentries
c.i27
j3: ba w0 x3+412 ; -strange maincat entries
j7: hs w0 x3+412 ;
z.c.-i27
j3: ba w0 x3+410 ;
j7: hs w0 x3+410 ;
z.
sh w0 -1 ; if temp entry claim exceeded then
hs. w0 b36. ; claims exceeded:=true;
sh w0 -1 ;
jd -1 ;
z.
ac w2 1 ; w2:= -1;
jl. w3 c5. ; output last segment on usercat;
rl. w0 b41. ;
rl. w1 (b16.) ; w1:= own corutine descr;
rs w0 x1+12 ; restore page 3;
rl. w2 b5. ; w2:= abs ref reserve usercat semaphore;
jl. w3 (b6.) ; open(w2); w3:= abs ref page 1;
bz. w0 b36. ; w0:= claims exceeded;
dl w3 x3+2 ; w2w3:= return;
se w0 0 ; if claims exceeded
jl. (b8.) ; then page jump(error return);
rl. w2 b4. ; w2:= abs ref catalock semaphore;
jl. w3 (b6.) ; open(w2); w3:= abs ref page 1;
dl w3 x3+2 ; w2w3:= return;
al w3 x3+2 ; normal return:= call + 4;
jl. (b8.) ; page jump(return);
a2:
c.i27
; drum:
j4: dl w1 x3+411 ;
ds. w1 b40.+4 ; rest 1,2:=drumrest 1,2
j5: rl w2 x3+408 ;
jl. w3 c5. ; get usercat
al w0 2.1101 ; mask:=key 3,2,0
jl. w3 c2. ; translate
rl. w0 b40. ; w0:=entries,slices key 0+1
rl. w1 b40.+4 ; w1:=entries,slices key 2
j9: ds w1 x3+411 ; drumrest 1,2:=w01
rl. w0 b40.+6 ; w0:=entries,slices key 3
jl. a7. ; goto save in usercat
\f
;boj 26.4.72 boss 2, bsadjust, ...17...
a3:
z.
; disc:
j11: dl w1 x3+409 ;
ds. w1 b40.+4 ; rest 1,2:=discrest 1,2
j12: rl w2 x3+407 ;
jl. w3 c5. ; get usercat
al w0 2.1101 ; mask:=key 3,2,0
jl. w3 c2. ; translate
rl. w0 b40. ; w0:=entries,slices key 0+1
rl. w1 b40.+4 ; w1:=entries,slices key 2
j16: ds w1 x3+409 ; discrest 1,2:=w01
rl. w0 b40.+6 ; w0:=entries,slices key 3
c.i30-1
jl. a7. ; goto save in usercat
a8:
; unknown kit:
rl. w3 b35. ; get temporary
ws w3 92 ; claims on unknown kits
ls w3 2 ;
al. w3 x3+b20. ;
dl w1 x3+2 ;
ds. w1 b40.+2 ;
dl w1 x3+6 ;
ds. w1 b40.+6 ;
al w1 6 ;
jl. w3 c9. ; adjust rest3(w1 = sub from entries);
al w1 7 ;
jl. w3 c9. ; adjust rest3(w1 = sub from slices);
al w0 2.1111 ; mask:= key 3210;
jl. w3 c2. ; translate;
rl. w3 b35. ; save temporary
ws w3 92 ; claims on unknown kits
ls w3 2 ;
al. w3 x3+b20. ;
dl. w1 b40.+2 ;
ds w1 x3+2 ;
dl. w1 b40.+6 ;
ds w1 x3+6 ;
jl. a6. ; goto step docindex;
a5:
; private kit:
rl. w3 b39. ; b39 = abs ref kittable entry, you know
rl w2 x3+8 ; w2:= usercat ref rest 3
jl. w3 c5. ; get usercat
al w0 2.0001 ; mask:=key 0
jl. w3 c2. ; translate
rl. w0 b40. ; w0:=entries,slices key 0+1+2+3
z.
a7: al w2 -1 ; save in usercat:
rs w0 2 ;
rx. w0 (b46.) ; save claim in usercat
se w0 x1 ; if any changes
hs. w2 b31. ; then writing:=true
; comment if b46 = ref b45 and writing then bossalarm.
; to be implemented at occasion.
; in that case the job has removed areas on a disc
; he must not know.
jl. a6. ; goto step docindex;
g11=j11+1
g12=j12+1
g16=j16+1
c.i27
g4=j4+1
g5=j5+1
g9=j9+1
z.c.i30-1
g0=j0+1
z.c.i27+i30
g1=j1+1
g2=j2+1
g3=j3+1
g7=j7+1
z.
e. ;
\f
; boj 5.1.72 boss 2, bs adjust, ...18...
; procedure get rest3 from usercat:
; =================================
; call return
; w0 unch
; w1 undef
; w2 usercatrefrest3 undef
; w3 link abs ref page 4
; b46 abs ref rest3
; b40(0:5) rest(0:2) unch
; b40(6:7) rest3 corrected for loans
;
; w2=0 : rest3=0
; w2=-1 : output last segment
; w2=seg<12+rel : else
;
; abstract: start: if newsegment<> current segment then goto write;
; adjust rest3;exit;
; write: if current segment = -1 then goto read; if writing then
; outblock(current); current:= -1; goto start;
; read: current:= new; inblock(current); writing:=false; goto start;
b. a6 w. ;
c5: ws. w3 b0. ;
ds. w0 b33. ; save w3w0;
rs. w2 b45. ; save w2;
se w2 0 ; if usercatref=0
jl. a0. ; then
al. w2 b45. ; w2:=ref 0
jl. a3. ;
; start:
a0: bl. w0 b45. ; w0:= new segment;
se. w0 (b47.+6); if new <> current
jl. a1. ; then goto write;
bl. w2 b45.+1 ; w2:= page 3 rel ref rest3
sn w2 -1 ; if -1
jl. a5. ; then return
wa. w2 b0.+6 ; w2:=abs ref rest3
a3: rs. w2 b46. ; b46:= abs ref rest3;
rl w0 x2 ;
rs. w0 b40.+6 ; save rest3
al w1 6 ;
jl. w3 c9. ; adjust rest3(w1=sub from entries)
al w1 7 ;
jl. w3 c9. ; adjust rest3(w1=sub from slices)
a5:
rl. w1 (b16.) ;
bz w0 x1+4 ;
so w0 2 ; if test 2 then
jl. a6. ;
al. w1 b40. ; privout b40
al w0 10<6+16;
jl. w3 (b50.) ;
a6: rl. w3 b0.+8 ; w3:=ref page4
rl. w0 b33. ; w0:= save w0;
am. (b33.-2); return;
jl. b0. ;
\f
; boj 7.12.72 boss 2, bs adjust, ...19...
; write: w0 = new segment.
a1: rl. w1 b47.+6 ; w1:= current segment;
sn w1 -1 ; if current = -1
jl. a2. ; then goto read;
bl. w0 b31. ; if writingbit
sn w0 0 ;
jl. a4. ; then begin
al w2 5 ; w2:= 5;
hs. w2 b47. ; operation:= output;
rl. w1 b0.+6 ;
al w2 x1+510 ;
ds. w2 b47.+4 ; message:=first last
al. w1 b47. ; w1:= ref message;
al. w2 b48. ; w2:= ref<:usercat:>;
jl. w3 (b2.) ; send and wait fast;
se w0 2 ; if not normal answer
c.-1, o81, z. ; (bossfault xref)
jd -81 ; then bossalarm;
a4: ac w1 1 ; end w1:= -1;
rs. w1 b47.+6 ; current:= -1;
jl. a0. ; goto start;
; read: w0 = new segment.
a2: rs. w0 b47.+6 ; current:= new;
al w2 3 ; w2:= 3;
hs. w2 b47. ; operation:= input;
rl. w1 b0.+6 ;
al w2 x1+510 ;
ds. w2 b47.+4 ; message:=first last
al. w1 b47. ; w1:= ref message;
al. w2 b48. ; w2:= ref<:usercat:>;
jl. w3 (b2.) ; send and wait fast;
se w0 2 ; if not normal answer
c.-1, o82, z. ; (bossfault xref)
jd -82 ; then bossalarm;
al w0 0 ;
hs. w0 b31. ; writing:=false
jl. a0. ; goto start;
e. ;
\f
; boj 6.4.72 boss 2, bs adjust, ...20...
c.i27+i30
c8:
; integer procedure strange maincat entries
;
; call return
; w0 result
; w1 und
; w2 und
; w3 link abs ref page 4
b. a2 w.
ws. w3 b0. ; save return
rs. w3 b27. ;
rl. w3 b0.+8 ; w3:=ref page4
ld w1 64 ; w0:=0
ds. w1 b40.+6 ; b40(0:7):=0
ds. w1 b40.+2 ;
c.i30-1 ; if private kits
j13: al w1 x3+403 ; then begin
a1: ; for b39:=first in kittable
rl w2 x1+0 ; while name(b39)<>0
sn w2 0 ; do begin
jl. a0. ;
rl w2 x1+8 ;
ws w1 6 ;
rs. w1 b39. ;
jl. w3 c5. ; get usercat
ba. w0 b40.+6 ; w0:=w0+kitentries
al w1 x3+14 ; b39:=b39+14
wa. w1 b39. ;
jl. a1. ; end
a0: ;
z. ; end
c.i27 ; if drum
j10: dl w2 x3+409 ; then begin
ds. w2 b40.+4 ; b40(2:5):= discrest(1:2);
j14: rl w2 x3+407 ;
jl. w3 c5. ; get usercat
ba. w0 b40.+4 ; w0:=w0+discentries(2)
ba. w0 b40.+6 ; +discentries(3)
z. ; end
am. (b27.) ;
jl. b0. ;
c.i27
g10=j10+1
g14=j14+1
z.c.i30-1
g13=j13+1
z.
e.
z.
\f
; boj 30.8.71 boss 2, bs adjust, ...21...
; procedure translate:
; ====================
; abstract:
; (1-1 )
; rest:= rest + ( 1-1 ) (new - old)
; ( 1-1)
; ( 1)
; old:= new;
; rest(3)
; :=rest(3)
; + min(0,rest(2),rest(2)+rest(1)
; ,rest(2)+rest(1)+rest(0)
; )
; (1 )
; rest:= ( 1 ) * rest
; ( 0 )
; ( 1 1)
; for mask=(1 1 0 1); if claims exceeded then rise flag
; end;
; w0 = mask
; b37 = ref new
; b40 = ref rest
; b27 = ref old
; procedure translate:
b. a5 w. ;
c2: rs. w3 b49. ; save return;
hs. w0 b7. ; save mask
rl. w3 b35. ;
ws w3 92 ;
ls w3 2 ;
al. w3 x3+b30. ;
rs. w3 b27. ;
al w1 6 ; w1:=6
a1: hs. w0 b10. ; shiftmask:=mask
al w0 0 ;
rs. w0 b28. ; b28:= b29:= 0;
a0: bl. w0 x1+b40. ; rep:
bs. w0 b28. ; rest:= rest - b28;
bl. w2 x1+b37. ;
am. (b27.) ;
bl w3 x1 ;
am. (b27.) ;
hs w2 x1 ; old:= new;
bs w2 7 ;
hs. w2 b28. ; b28:= new - old;
ba w0 5 ;
bl. w2 b10. ; leftshift shiftmask
ls w2 1 ;
hs. w2 b10. ;
sz w2 1<4 ; if mask(key)=0
jl. a3. ; then begin
ba. w0 x1+b40.-2 ; rest(next lower key)
hs. w0 x1+b40.-2 ; +:=rest
al w0 0 ; rest:=0
a3: ; end
hs. w0 x1+b40. ; rest:= rest + b28;
ba. w0 b29. ;
hs. w0 b29. ; b29:= b29 + rest;
sh w0 -1 ; if b29<0
hs. w0 b36. ; then claims exceeded:=true
sh w0 -1,jd-1
al w1 x1-2 ; w1:= w1 - 2;
sl w1 0 ; if w1 >= 0 then
jl. a0. ; goto rep;
jl. w3 c9. ; adjust key 3(w1=add to entries or slices)
se w1 -2 ; if w1 = -2 then
jl. a2. ; begin
al w1 7 ; w1:= 7;
bl. w0 b7. ; w0:=mask
jl. a1. ; goto set b28 - b29;
a2: rl. w3 b0.+8 ; end else w3:= ref page 4;
jl. (b49.) ; return;
e. ;
\f
; boj 14.11.72 boss 2, bs adjust, ...21a...
c9:
; procedure adjust key 3
;
; call: return: local use:
; w0 undef min
; w1 code unchanged code
; w2 undef index
; w3 link ref page 4 sum
; b40 rest(0:3) rest(0:3)
;
;
; code = 6: subtract entries
; -2: add entries
; 7: subtract slices
; -1: add slices
;
; this procedure prevents two jobs under the same project
; from using the same permanent claims.
; the value in the usercat is actually:
; rest(3) minus the loans of all the jobs.
; before =translate= this is transferred to:
; rest(3) minus the loans of all other jobs
; and afterwards it is transferred back again.
b. a1 w. ;
rs. w3 a0. ; save link;
ldw0 -100 ; min:= sum:= 0;
sz w1 1 ; index:= if code odd
am 1 ; then 5
al w2 4 ; else 4;
a1: ba. w3 x2+b40. ; loop: sum+:= rest(index);
sl w0 x3 ; if min > sum then
al w0 x3 ; min:= sum;
al w2 x2-2 ; index-:= 2;
sl w2 0 ; if index >= 0 then
jl. a1. ; goto loop;
sl w1 0 ; if code >= 0 then
ac w0 (0) ; min:= - min;
ba. w0 x2+b40.+8 ; rest(3)+:= min;
hs. w0 x2+b40.+8 ;
rl. w3 b0.+8 ; w3:= ref page 4;
jl. (a0.) ; return;
a0: 0 ; save link;
e. ;
\f
; boj 5.1.72 boss2 bs adjust ...22...
; procedure prepare bs adjust and transfer permanent claims
; from usercat to jobdescription
;
b. a5 w.
c6: dl w1 x3+2 ;
ds. w1 b32.+2 ; save return
dl. w3 b18. ;
jl. w1 (b9.) ; call prepare bs adjust
rl. w1 (b16.) ;
rl. w0 b15. ;
rx w0 x1+12 ; page3:=usercat buffer
rs. w0 b41. ; save old page3
rl. w2 b5. ;
jl. w3 (b3.) ; lock( reserve usercat)
al w0 -1 ;
rs. w0 b47.+6 ; current:=-1
rl. w3 b0.+8 ; w3:=ref page4
ld w1 -100 ; clear b40(0:7)
ds. w1 b40.+2 ;
ds. w1 b40.+6 ;
c.i30-1 ; if private kits
j17: al w1 x3+403 ; then begin
a0: ; for b39:=first in kittable
rl w2 x1+0 ; while name(b39)<>0
sn w2 0 ; do begin
jl. a1. ;
rl w2 x1+8 ; w2:=usercatref rest3
ws w1 6 ;
al w0 x1+10 ; w0:=page4ref rest3
rs. w1 b39. ;
jl. w1 c7. ; compare
al w1 x3+14 ; b39:=b39+14
wa. w1 b39. ;
jl. a0. ;
a1: ; end
z. ; end
c.i27 ; if drum
j18: dl w2 x3+411 ; then begin
ds. w2 b40.+4 ; b40(2:5):=rest(1:2)
j19: rl w2 x3+408 ; w2:=usercatref rest3
j20: al w0 476 ; w0:=page4ref rest3
jl. w1 c7. ; compare
z. ; end
j21: dl w1 x3+409 ;
ds. w1 b40.+4 ; b40(2:5):=discrest(1:2)
j22: rl w2 x3+407 ; w2:=usercatref rest3
j23: al w0 475 ; w0:=page4ref rest3
jl. w1 c7. ; compare
rl. w0 b41. ;
rl. w1 (b16.) ;
rs w0 x1+12 ; restore page3
rl. w2 b5. ;
jl. w3 (b6.) ; open (reserve usercat)
dl. w3 b32.+2 ;
jl. (b8.) ; pagejump(saved return)
c.i30-1
g17=j17+1
z.c.i27
g18=j18+1
g19=j19+1
g20=j20+1
z.
g21=j21+1
g22=j22+1
g23=j23+1
e. ;end a-names
\f
; boj 5.1.72 boss2 bsadjust ...23...
;
; procedure compare
; call return
; w0 page4ref(a) undef
; w1 link unch
; w2 usercatref(b) und
; w3 ref page4 unch
c7: ws. w1 b0. ;
rs. w2 b27.-4 ; save usercat ref;
ds. w1 b27. ; save page 4 ref and return;
am (0) ;
rl w1 x3 ; b40(6:7):= perm option key3;
rs. w1 b40.+6 ;
al w1 6 ; adjust key 3(entries, slices);
jl. w3 c9. ;
al w1 7 ;
jl. w3 c9. ;
rl. w1 b40.+6 ;
am. (b27.-2); perm option key 3:= b40(6:7);
rs w1 x3 ;
rl. w2 b27.-4 ; get usercat ref;
jl. w3 c5. ; get usercat segment
wa. w3 b27.-2 ; w3:=absref(a)
bz w0 x3 ; get a.entries
bz. w1 b40.+6 ; and b.entries
sl w0 x1 ; if a>=b
hs w1 x3 ; then a:=b
bz w0 x3+1 ; and similarily for slices
bz. w1 b40.+7 ;
sl w0 x1 ;
hs w1 x3+1 ;
rl. w3 b0.+8 ; w3:=ref page4
rl. w1 b27. ; return
jl. x1+b0. ;
f5=k-b0 ;
f6=c0-b0 ;
f7=c1-b0 ;
f8=c6-b0 ;
i. e. ; end bsadjust procedures segment
\f
; rc 02.10.71 boss 2, init from usercat ...24...
; first the job-descr. is initialized with the boss-2 std values
; next the project number is searched in the user catalog:
; first by lookup in the index from which the first relevant
; segment number in the catalog is obtained
; then the project number is searched on the actual segment
; and all project values are transferred to the job-descr. .
;
; finally the actual user is searched, and all user values are
; transferred to the job-descr. .
;
;
; the routine may be called from any coroutine, but works singular
; by locking a binary semaphore on entry and opening it on exit.
;
;
; 3 types of exits are performed:
; normal exit to call + 8
; used exit to call + 6 when the jobname is allready
; used
; not found exit to call + 4 when project number or user
; is not found in the catalog
; illegal exit to call + 2 when the user index is too big
;
;
; the pages are used as follows:
; page 0 code and variables
; page 1 not used (but restablished on exit)
; page 2 not used
; page 3 user cat buffer
; page 4 job-descr.
;
;
; names on page 0
; a - names are used as local labels
; b - names are used as global variables and constants
; c - names are used as global labels
; j - names are used as local variables
;
; names on page 4
; d - names are used as relative addresses in the job-descr.
;
; global names
; g - names are used as table bases (g20 and g21) and to define
; the values in the external list.
b. f10 w. p.2 ; input jobdescr
s. g50 w.
; external table
h4=h3. ;
g25., g26., g27., g28., g29., g30., g31., g32., g33., g34.
g35., g36., g37., g38., g39., g41., g42.
h5: h6 ; end external list
jl. g24. ; goto start init
b. b35, c25
w.
\f
; rc 02.10.71 boss 2, init from usercat ...25...
; initialize code and variables
g24: al w0 1 ; reserve - usercat -
rs. w0 (b9.) ; semaphore := 1;
rl. w0 b9. ; ext 75 := abs addr of
rs. w0 b33. ; ext(75);
al w0 i38 ; w0 := reserve on disc
al w1 512 ; w1 := length of page 3
jl. w3 (g25.) ; reserve virt (w0, w1);
al w2 x2+1 ; writing(virt addr) := true;
rs. w2 b20. ; save virt addr;
rs. w2 b34. ; ext(416);
al w0 i37 ; w0 := reserve on disc;
al w1 g23 ; w1 := length of page0;
jl. w3 (g25.) ; reserve virt (w0, w1);
al w2 x2+1 ; writing (virt addr) := true;
al w3 g22 ; w3 := rel entry on page 0;
rs. w2 b31. ;
rs. w3 b32. ;
jl. w3 (2) ; set externals;
g27: 40 ;
b33: 0 , 75 ; reserve usercat semaphore;
b34: 0 , 416 ; virt addr of usercat buffer;
b31: 0 , 159 ; virt addr of page 0;
b32: 0 , 160 ; rel entry page 0;
d26, 529 ; rel project base (not maxbase)
0 , -1000 ; end of externals;
al. w0 b0. ; w0 := first of page 0;
jl. w3 (g26.) ; move to virt (w0, w1);
am.(4,jl.4,h3.) ; goto initialize bsadjust
g25: 12 ; reserve virt
g26: 13 ; move to virt
g28: 0 ; start of ext. table
\f
; rc 02.10.71 boss 2, init from usercat ...26...
; global variables and constants for all page 0
;
; start of page 0
b0: 0 ; abs addr of page 0
b1: 0 ; abs addr of page 1
b2: 0 ; abs addr of page 2
b3: 0 ; abs addr of page 3
b4: 0 ; abs addr of page 4
82<12 + 0 ; page ident: init from usercat
b5: 2 ; ext. send and wait fast
b6: 0 ; global work (normally an address)
b7: <:usercat:>,0 ; name of usercat
g35: 286 ; external name table address
b8: 4<12 ; top type of interest in scan
b9: h. e13, 19 w. ; ext. reserve-usercat-semaphore
b10: 3 ; ext. lock
b11: 4 ; ext. open
;b12 ; start + 2 of std values
;b13 ; last of std values
b14: 3<12, 0 ; input message: operation, first
b15: 0 ; last of transfer
b16: 0 ; segment number
;b17 0 or 1 ; state: 0 = user found, 1 = project found
b18: 26 ; ext. addr of cur coroutine descr addr
0 ;
b19: 0 ; saved return point
b20: 0 ; virt addr of page 3
b21: 0 ; saved page 1 addr
b22: 8 ; ext page jump addr
b23: 7 ; ext get pages
b24: 280 ; ext virt addr of banker page
b25: 281 ; ext rel of first job name
b26: 284 ; ext job descr length
0 ;
b29: 0,0 ; job name part 1
b30: 0 ; job name part 2
; g - names
; g20: start of action table
; g21: start of rel.addr. in job-descr.
; g22: rel entry in page 0
; g23: length of page 0
; define addresses in external list:
g29 = b5
g30 = b9
g31 = b10
g32 = b11
g33 = b18
g34 = b22
g36 = b23
g37 = b24
g38 = b25
g39 = b26
\f
; rc 02.10.71 boss 2, init from usercat ...27...
; entry page 0
;
; registers: undefined
; page 0 : this page
; page 1 : coroutines page 1
; page 2 : 0
; page 3 : irrelevant
; page 4 : job-descr.
g22 = k - b0 ; define rel entry of page 0
rl. w0 b20. ;
rl. w2 (b18.) ;
rs w0 x2+12 ; insert page-3 descr;
rl. w2 b9. ; w2 := semaphore;
jl. w3 (b10.) ; lock (w2);
dl w1 x3+2 ;
ds. w1 b19. ; save return point;
al w0 0 ;
rl. w2 (b18.) ; page-1 descr := 0;
rx w0 x2+8 ;
rs. w0 b21. ; save old page-1 descr;
; insert std values in job description
;
; b12 = start + 2 of std values
; b13 = last of std values
; d63 = first + 2 of job-descr. to be initialized
b.a0
w.
al. w1 b12. ; from := start + 2;
am. (b4.) ;
al w2 +d63 ; to := first + 2 in page 4;
a0: dl w0 x1 ; rep:
ds w0 x2 ; double(to) := double(from);
al w1 x1+4 ; from := from + 4;
al w2 x2+4 ; to := to + 4;
sh. w1 b13. ; if from <= last then
jl. a0. ; goto rep;
e.
\f
; rc 25.10.71 boss 2, init from usercat ...28...
; search project number in index
b. a5, j0
w.
al w1 0 ; get and
rs. w1 j0. ; save first index segm no;
jl. w3 c6. ; comment w2 := first index;
a0: am. (b4.) ; get project:
rl w0 +d20 ; w0 := project from job-descr. ;
a1: sh w0 (x2) ; test: if w0 > word(w2) then
jl. a2. ; begin
al w2 x2+2 ;
am. (b3.) ; if w2 < top of segment then
sh w2 +510 ; goto test;
jl. a1. ;
jl. w3 c5. ; next segment;
jl. a0. ; goto get project;
; end;
a2: ws. w2 b3. ; w2 := final segment no
ls w2 -1 ; mod 256;
rl. w1 b16. ; w1 := relative
ws. w1 j0. ; index segm no
ls w1 8 ; * 256 +
wa w1 4 ; w2;
jl. w3 c6. ; get segment (w1);
j0 = b30 ; use jobname area as work;
; search actual type-0 record in page 3
; if not found on the actual segment, an
; error exit is performed;
se w1 x1 ; if false then
a3: ba w2 x2+1 ; next: w2 := addr of next;
rl w0 x2 ; w0 := type. length;
sl w0 512 ; if type > 0 then
jl. a3. ; goto next;
sn w0 0 ; test: if type, length = 0 then
jl. c3. ; goto exit not found;
rl w0 x2+2 ; w0 := project(w2);
am. (b4.) ;
rl w1 +d20 ; w1:= actual project;
sh w0 x1-1 ; if w0 < actual then
jl. a3. ; goto next;
se w0 x1 ; if w0 <> actual then
jl. c3. ; goto exit not found;
; now w2 points on the actual type-0 record
; transfer the contents
jl. w3 c1. ; calculate address;
rl. w3 b4. ; w3 := base of job-descr. ;
al w1 x1+8 ;
rs w1 x3+d22 ; save addr of rest claims;
dl w1 x2+6 ;
ds w1 x3+d21 ; transfer max interval, may be redifined in case of a userpool;
ds w1 x3+d26 ; project interval, may not be redefined;
al w0 1 ;
hs. w0 b17. ; state := 1; (project found);
hs. w0 b27. ; userpool:= false(=1);
e.
\f
; rc 02.10.71 boss 2, init from usercat ...29...
; next record
;
; the address of the next record is made available in w2
; exit is made to the action found in table g20
;
; entry exit
;
; w0 - type, length
; w1 - type
; w2 old record new record
; w3 - destroyed
b. a1
w.
c9: ba w2 x2+1 ; w2 := top addr of old record
a0: rl w0 x2 ; test type
sn w0 0 ; if type, length = 0 then
jl. a1. ; goto next;
bz w1 0 ; w1 := type;
bz w3 0 ; w3 := type>1
ls w3 -1 ;
sl w3 g19 ; (if outside table then
c.-1, o89, z. ; (bossfault xref)
jd -89 ; bossfault 89)
ba. w3 x3+g20. ; + byte(table+type>1);
jl. x3+g20. ; goto action(table+x3);
a1: jl. w3 c5. ; next: call next segment;
jl. a0. ; goto test type;
e.
; the following contains the actions transferring
; information from the user catalog to the job
; description
; type 0 action
; goto if state = 0 then normal exit
; else not found exit
c10: bz. w0 b17. ; w0 := state;
se w0 0 ; if w0 <> 0 then
jl. c3. ; goto not found exit;
jl. c2. ; goto normal exit;
; type 2 action
; if state = 0 then goto normal exit;
; search actual user
; state := 1;
c11: sn w1 x1 + 0 ; if state = 0 then
jl. c2. ; goto normal exit;
b17 = c11+1 ; define state
\f
; rc 05.01.72 boss 2, init from usercat ...30...
; search user
b. a20, j10
w.
a0: am. (b4.) ; start:
al w3 +d23 ; w3 := addr of user name;
a1: dl w1 x3+2 ; test name:
sn w0 (x2+2) ; if first part of name
se w1 (x2+4) ; not ok then
jl. a2. ; goto nextrec;
dl w1 x3+6 ;
sn w0 (x2+6) ; if second part of name
se w1 (x2+8) ; not ok then
jl. a2. ; goto nextrec;
jl. a5. ; goto found;
a2: ba w2 x2+1 ; nextrec: w2 := top of record;
am. (b3.) ;
sl w2 +512 ; if w2 > last of segment then
a3: jl. w3 c5. ; next: next segment;
rl w0 x2 ; w0 := type, length;
sl. w0 (b8.) ; if w0 > 3<12 then
jl. a2. ; goto nextrec;
sn w0 0 ; if w0 = 0 then
jl. a3. ; goto next;
sh w0 512 ; if type = 0 then
jl. c3. ; goto exit not found;
jl. a0. ; goto start;
; transfer contents of type 2 record;
a5: rl. w3 b4. ; found: w3 := base of job-descr. ;
rl w0 x3+d61 ; w0 := user id addr;
se w0 0 ; if w0 = 0 then
jl. a6. ; begin
jl. w3 c1. ; calculate address;
al w1 x1+2 ;
rl. w3 b4. ; insert user id addr;
rs w1 x3+d61 ; end;
a6: rl w1 x3+d25 ; w1 := user index;
sl w1 (x2+14) ; if w1 >= top index then
jl. c4. ; goto illegal exit;
wm w1 x2+12 ; w1 := userindex * sublength
wa w1 x2+10 ; + start of interval;
hs. w0 b17. ; state := 0; comment w0 = 0;
hs. w0 b27. ; userpool:= true;
al w0 x1-1 ; w0 := w1-1+sublength;
wa w0 x2+12 ;
rx w1 0 ; change (w0, w1);
ds w1 x3+d24 ; save std interval;
rl w1 x2+12 ; userinterval :=
wm w1 x2+14 ; (start interval,
wa w1 x2+10 ; start interval +
al w1 x1-1 ; top user index *
rl w0 x2+10 ; sublength - 1);
ds w1 x3+d24+4 ;
\f
; rc 02.10.71 boss 2, init from usercat ...31...
; create jobname
;
; 1. insert user name as jobname
dl w1 x3+d23+2 ;
ds w1 x3+d19+2 ; move name
dl w1 x3+d23+6 ;
ds w1 x3+d19+6 ;
al w1 x3+d19 ; w1 := addr of name;
a7: rl w0 x1 ; next:
so. w0 (j0.) ; if word(w1) is not filled then
jl. a8. ; goto convert;
al w1 x1+2 ; w1 := addr of next word;
jl. a7. ; goto next;
; 2. convert user index to text
a8: ws. w2 b3. ; w2 := rel of w2;
ds. w2 j2. ; save w1, w2;
rl w2 x3+d25 ;
sh w2 9 ; if user index < 10 then
jl. a9. ; goto single;
al w1 0 ;
wd. w2 j3. ; separate digits;
al w2 x2+48 ;
so. w0 (j4.) ;
ls w2 8 ;
so. w0 (j5.) ; insert 1. digit as text
ls w2 8 ; in job name
wa w0 4 ;
rs. w0 (j1.) ;
al w2 x1 ; number := 2. digit
a9: al w2 x2+48 ; single:
sz w0 32 ; if textword is filled then
jl. a10. ; goto new word;
so. w0 (j4.) ;
ls w2 8 ;
so. w0 (j5.) ; insert number as text
ls w2 8 ; in jobname;
wa w0 4 ;
rs. w0 (j1.) ;
jl. a11. ; goto move to banker;
a10: ls w2 16 ; new word:
am. (j1.) ; word (w1+2) :=
rs w2 + 2 ; number shift 16;
; 3. move job name to banker page
a11: dl w1 x3+d19+2 ; move jobname to
ds. w1 b29. ; work area;
dl w1 x3+d19+6 ;
ds. w1 b30. ;
rl. w0 b24. ;
rl. w2 (b18.) ;
rs w0 x2+8 ; page 1 := banker page;
jl. w3 (b23.) ; get pages;
a12: rl. w3 b1. ; again:
wa. w3 b25. ; w3 := addr of first job name;
al w0 i45 ; rest psjobs :=
rs. w0 b6. ; no of psjobs;
\f
; rc 02.10.71 boss 2, init from usercat ...32...
a14: dl. w1 b29. ; test next: if first part of
sn w0 (x3+0) ; jobname = first part of
se w1 (x3+2) ; jobname in banker then
jl. a13. ; goto not used;
dl. w1 b30. ; if second part of jobname
sn w0 (x3+4) ; = second part of jobname
se w1 (x3+6) ; in banker then
jl. a13. ; goto not used;
jl. a16. ; goto test psjobno;
a13: wa. w3 b26. ; not used: w3 := addr of next job name;
al w1 -1 ; rest psjobs :=
wa. w1 b6. ; rest psjobs -1;
rs. w1 b6. ;
se w1 0 ; if rest psjobs <> 0 then
jl. a14. ; goto test next;
am. (b4.) ;
bz w2 d14+3 ; w2 := psjob no
al w2 x2-2 ; -2
wm. w2 b26. ; * length of description
wa. w2 b25. ; + rel of first description
wa. w2 b1. ; + base of descriptions;
dl. w1 b29. ;
ds w1 x2+2 ; move jobname to
dl. w1 b30. ; banker page;
ds w1 x2+6 ;
a15: rl. w2 (b18.) ; release:
al w0 0 ;
rs w0 x2+8 ; release banker page;
rl. w2 j2. ; w2:= saved rel record +
wa. w2 b3. ; abs user cat buf;
jl. c9. ; goto next record;
; test psjobno
; if psjobno(banker) <> psjobno(psjobdescr)
; then goto used exit;
a16: ws. w3 b1. ; w3 := psjobno(banker) :=
ws. w3 b25. ; (abs cur name - page 1
al w2 0 ; - rel of first name)/
wd. w3 b26. ; length of entry;
am. (b4.) ; w3 := w3 -
bs w3 +d14+3 ; psjobno (psjobdescr);
se w3 -2 ; if w3 <> -2 then
jl. c7. ; goto used exit;
jl. a15. ; goto release;
j0: 32<16+32<8+32 ; 3 chars used mask
j1: 0 ; saved w1
j2: 0 ; saved w2
j3: 10 ;
j4: 32<8 ; 2. char used mask
j5: 32<16 ; 1. char used mask
j6: 4095 ; serial jobno mask
e.
\f
; rc 02.10.71 boss 2, init from usercat ...33...
; type 4 action
; transfer respite directely;
; transfer priority through store byte;
c12: rl w0 x2+4 ;
am. (b4.) ;
rs w0 +d27 ; transfer respite;
jl. c15. ; goto store byte;
; type 6 action
; search device name
; transfer address of claims
b. a1 w.
c13: se w1 x1+0 ; if userpool then
b27=c13+1 ; begin
jl. a1. ;
rl. w3 b4. ; maxinterval:=
dl w1 x3+d24 ; std interval;
ds w1 x3+d21 ;
al w3 1 ; w3:= 1;
hs. w3 b27. ; userpool:= false;
al w0 0 ;
am. (b4.) ;
rs w0 +d62 ; no of privkits:= 0;
a0: sl w3 d80-d28; clear all private kit table...;
jl. a1. ;
am. (b4.) ;
rs w0 x3+d28-1 ;
al w3 x3+2 ;
jl. a0. ; end;
a1: ;
jl. w3 c0. ; search devicename
rl w1 x2+14 ; slicelength:= slice length of kit;
rl w0 x2+10 ; job claims := rest claims;
ds w1 x3+d113 ;
jl. w3 c1. ; calculate address
al w1 x1+10 ; of rest claims;
am. (b6.) ;
rs w1 +d29 ; save address;
jl. c9. ; goto next record;
e. ;
\f
; rc 19.12.72 boss 2, init from usercat ...33a...
; type 8 action
; transfer variable length record to job-descr.
b.a1
w.
c14: bz. w1 x1+g21. ; w1 := rel on job descr;
hs. w1 a1. ;
bz w1 x2+1 ; w1 := no of bytes + 2;
a0: al w1 x1-2 ; next: w1 := w1 - 2;
am (x2) ;
rl w0 x1 ; w0 := word(record+x1);
am. (b4.) ; word(job-descr. +
a1=k+1
rs w0 x1;+d30-2 ; rel-of-bits + x1) := w0;
se w1 2 ; if w1 <> 2 then
jl. a0. ; goto next;
jl. c9. ; goto next record;
e.
; transfer byte
c15: rl w0 x2+2 ; w0 := word (record + 2);
bz. w1 x1+g21. ; w1 := rel in job-descr. ;
am. (b4.) ;
hs w0 x1 ; byte(list + x1) := w0;
jl. c9. ; goto next record;
; transfer word
c16: rl w0 x2+2 ; w0 := word( record + 2);
bz. w1 x1+g21. ; w1 := rel in job-descr. ;
am. (b4.) ;
rs w0 x1 ; word(list + w1) := w0;
jl. c9. ; goto next record;
\f
; rc 02.10.71 boss 2, init from usercat ...34...
; transfer double
c17: dl w0 x2+4 ; w3,w0 := double(record + 4);
bz. w1 x1+g21. ; w1 := rel in job-descr. ;
am. (b4.) ;
ds w0 x1 ; double(list + w1) := w3,w0;
jl. c9. ; goto next record;
; type 42, 44 action
; transfer addr of record(2);
c18: bz. w1 x1+g21. ;
rs. w1 b6. ; b6 := rel addr in list;
jl. w3 c1. ; calculate address
al w1 x1+2 ; + 2;
rl. w3 b6. ;
am. (b4.) ; word(list + b6) :=
rs w1 x3 ; address;
jl. c9. ; goto next record;
; type 48 action
; transfer private claim
c19: jl. w3 c0. ; search device name;
rl w0 x2+10 ; claims(device) :=
rs w0 x3+d57 ; word(record + 10);
jl. c9. ; goto next record;
; type 34 action
; transfer disc claims
; goto transfer double (max interval)
c20: rs. w1 b6. ; save w1
jl. w3 c1. ; calculate addr;
al w1 x1+6 ; addr := rel 6;
rl. w3 b4. ;
rs w1 x3+d22 ; save claim addr;
rl. w1 b6. ; get w1;
jl. c17. ; goto transfer double;
; type 54 action
; transfer program name
c21: bz. w3 x1+g21. ;
wa. w3 b4. ; w3 := abs destination;
dl w1 x2+4 ;
ds w1 x3+2 ;
dl w1 x2+8 ; move program name;
ds w1 x3+6 ;
al w1 0 ; name table addr := 0;
rs w1 x3+8 ;
jl. c9. ; goto next record;
\f
; rc 02.10.71 boss 2, init from usercat ...35...
; search device name
;
; entry exit
; w0 - destroyed
; w1 - destroyed
; w2 record addr unchanged
; w3 return device addr
; on exit b6 = device addr
b. a3, j0
w.
c0: rs. w3 j0. ; save return;
am. (b4.) ; w3 := addr of first device
al w3 +d28-14 ; - 14;
a0: al w3 x3+14 ; next: w3 := addr of next device;
dl w1 x3+2 ; w0,w1 := devicename(1);
sn w0 (x2+2) ;
se w1 (x2+4) ; if not expected name then
jl. a1. ; goto test empty;
dl w1 x3+6 ; w0,w1 := devicename(2);
sn w0 (x2+6) ;
se w1 (x2+8) ; if not expected name then
jl. a0. ; goto next;
jl. a2. ; goto save;
a1: se w0 0 ; test empty: if not empty then
jl. a0. ; goto next;
rl. w1 b4. ;
rl w0 x1+d62 ;
sl w0 i30 ; if no of kits >= max number of private kits then
c.-1, o87, z. ; (bossfault xref)
jd -87 ; boss alarm;
ba. w0 1 ; no of kits:= no of kits + 1;
rs w0 x1+d62 ;
dl w1 x2+4 ;
ds w1 x3+2 ; move name from usercat
dl w1 x2+8 ; to job-descr. ;
ds w1 x3+6 ;
a2: rs. w3 b6. ; save: b6 := device address;
jl. (j0.) ; return;
j0: 0 ; saved return;
e.
; calculate usercat address
; the current value of x2 is transformed to
; segmentno < 12 + segmentrel;
;
; entry exit
; w0 - destroyed
; w1 - address
; w2 abs addr unchanged
; w3 return return
c1: al w1 x2 ; w1 :=
ws. w1 b3. ; rel addr
ls w1 12 ; shift 12 +
rl. w0 b16. ; segmno shift 24
ld w1 -12 ; shift (-12);
jl x3 ; return;
\f
; rc 02.10.71 boss 2, init from usercat ...36...
; exits
; normal exit to call + 8
; used exit to call + 6
; not found exit to call + 4
; illegal exit to call + 2
c2: am 2 ; normal exit: w0 := 6 or
c7: am 2 ; used exit: w0 := 4 or
c3: am 2 ; not found exit: w0 := 2 or
c4: al w0 0 ; illegal exit: w0 := 0;
wa. w0 b19. ; rel := rel + w0;
rs. w0 b19. ; (rel = call + 2)
rl. w2 b9. ; w2 := semaphore;
jl. w3 (b11.) ; open (w2);
rl. w3 (b18.) ;
al w0 0 ;
rs w0 x3+12 ; page 3 addr := 0;
rl. w0 b21. ;
rs w0 x3+8 ; page 1 addr := saved addr;
dl. w3 b19. ; get return point;
jl. (b22.) ; return with page jump;
; next segment
;
; entry exit
; w0 - destroyed
; w1 - destroyed
; w2 - first of segment
; w3 link destroyed
c5: rl. w1 b16. ;
al w1 x1+1 ; w1 := segmno + 1;
; get segment
;
; entry exit
; w0 - destroyed
; w1 segment no destroyed
; w2 - first of segment
; w3 link destroyed
c6: rs. w1 b16. ; segmno := w1;
ws. w3 b0. ;
rs. w3 b6. ; b6 := rel return;
rl. w1 b3. ; w1 := first of transfer;
al w2 x1+510 ; w2 := last of transfer;
ds. w2 b15. ; save buffer limits;
al. w1 b14. ; w1 := message address;
al. w2 b7. ; w2 := name address;
jl. w3 (b5.) ; send and wait fast;
rl w1 x1+2 ; w1:= bytes transferred;
sn w0 1<1 ; if not normal answer or
se w1 512 ; bytes transferred <> 512 then
c.-1, o83, z. ; (bossfault xref)
jd -83 ; alarm;
rl. w2 b3. ; w2 := first of segment;
am. (b6.) ;
jl. b0. ; goto (page-0-start + rel);
\f
; rc 09.12.71 boss 2, init from usercat ...37...
; boss 2 std values
b12 = k + 2
<:fp:>,0,0,0,0 ; program name, table entry
h. 0 ; no of conversational input lines
0 ; tape table entries
w. i122 h. ; terminal user rights;
0, r.8 ; usercat addresses
c.i27,0 z. c.-i27, i126 z. ; temp disc entries
i121 ; - - slices
i113 ; login disc entries
i114 ; - - slices
2047 ; perm disc entries
2047 ; - - slices
c.-i27,0 z. c.i27, i126 z. ; temp drum entries
i127 ; - - slices
0 ; login drum entries
0 ; - - slices
2047 ; perm drum entries
2047 ; - - slices
c. i30 - 1
0, r.14*i30 z. ; space for private kits
0,0 ;
h. 0 ; std values online job allowed
i131 ; degree of information
w.
-1 ; max core lock
h. 1 ; priority
0 ; clean catalog
w. i134 ; waiting time swopped out
i123 ; link
h. 1 ; keys
i132 ; stations
0 ; mounts
0 ; tapes
i135 ; converts
i136 ; accounts
i137 ; output
i138 ; suspendings
w. i139 ; time
i140 ; size
h. i141 ; buffers
i142 ; areas
0 ; internals
1<5 ; function: generate name only
w. 1<23-1 ; max wait
0,r.6 ; intervals
0,0 ; device word
\f
; re 6.2.75 boss 2, init from usercat ...37a...
h. 0 ; max values online job allowed
1 ; degree of information
w.
-1 ; max core lock
h. 1 ; priority
0 ; clean catalog
w. i157 ; waiting time swopped out
i124 ; link
h. i143 ; keys
i144 ; stations
i145 ; mounts
i146 ; tapes
i147 ; converts
i148 ; accounts
i149 ; output
i150 ; suspendings
w. i151 ; time
i152 ; size
h. i153 ; buffers
i154 ; areas
i155 ; internals
1<5 ; function: generate name only
w. i156 ; respite
g41: -8 ; max device
g42: -7 ; max device
b13 = k
c.(:(:b13-b12+2-d65-4+d18:)a. 4095:)-1
m. *** wrong length initialize table
z.
\f
; rc 02.10.71 boss 2, init from usercat ...38...
; action table
; index = type > 1
c22=c9, c.i27, c22=c16 z.
h.
g20: ; type:
c10. , c11. , c12. , c13. , c14. , c15. ; 0 - 10
c15. , c15. , c15. , c15. , c15. , c15. ; 12 - 22
c15. , c16. , c15. , c15. , c16. , c20. ; 24 - 34
c22. , c16. , c16. , c18. , c18. , c16. ; 36 - 46
c19. , c16. , c9. , c21. , c15. , c15. ; 48 - 58
c16. , c15. , c15. , c16. , c15. , c16. ; 60 - 70
c15. ; 72-82
; relative addresses in pseudo-job-list
g21:
; std , max ; type , contents
0 , 0 ; 0 , (project)
0 , 0 ; 2 , (user)
d132 , d133 ; 4 , max priority and respite
0 , 0 ; 6 , (private)
d30-2, d65-2; 8 , device word
d31 , d32 ; 10 , accounts
d33 , d34 ; 12 , area claim
d35 , d36 ; 14 , buffer claim
d68 , d72 ; 16 , converts
d39 , d40 ; 18 , internal claim
d41 , d42 ; 20 , no of keys
d43 , d44 ; 22 , mounts
d45 , d46 ; 24 , output
d47 , d48 ; 26 , size
d49 , d50 ; 28 , stations
d51 , d52 ; 30 , tapes
d53 , d54 ; 32 , time
d21 , d21 ; 34 , max interval
d59 , d59 ; 36 , drum entries
d58 , d58 ; 38 , disc entries
d55 , d55 ; 40 , user entries disc
d61 , d61 ; 42 , user identification
d60 , d60 ; 44 , rest claim drum
d56 , d56 ; 46 , user entries drum
0 , 0 ; 48 , (user entries, private)
d66 , d27 ; 50 , latest
0 , 0 ; 52 , (project id)
d18 , d18 ; 54 , program name
d71 , d73 ; 56 , suspendings
d75 , d76 ; 58 , online job allowed
d77 , d78 ; 60 , max sec corelock
d102 , d103 ; 62 , degree of information
d132 , d133 ; 64 , priority
d138 , d139 ; 66 , waiting time
d134 , d135 ; 68 , clean catalog
d143 , d143 ; 70 , terminal user rights (priv);
d148 , d147 ; 72 , rblink
w.
g19=g21-g20 ; length of table
\f
; rc 07.04.72 boss 2, init from usercat ...39...
g23 = k - b0 ; define length of page 0
i.
e.e. ; end initialization from usercat
\f
; sl 14.7.71 boss 2, unknown sender, ...40...
; this corutine must be loaded last in order to get the last sender
; table entry.
s. b40, g40 w. ;
h6=h5. ; external list:
g10., g11., g12., g13., g14., g15., g16., g17., g18., g19.
g20., g21., g22., g23., g24., g25., g26., g27., g28., g29.
g30., g31., g32., g33., g34., g35.
h7: h8 ;
jl. g2. ; goto init;
b. a20, j10 w. ; begin code and variable page
g0: ;
b0: 0,r.5 ; page abs addresses
83<12 + 0 ; page ident: unknown sender
b1: g10: e13<12+19 ; unknown sender sem, reserve
b2: g11: 5 ; lock chain
b3: g12: 10<12+ 20 ; unknown sender in sender table, reserve
b4: 0 ; last terminal sender
b5: 0 ;-2 saved sender proc addr
b6: 0 ; saved sender table addr
b7: 10 ; length of sender table entry
b8: e12 ; length of corutine descr
b9: g13: 101 ; first commio corutine
b10: g14: 26 ; current corutine
b11: g15: 7 ; get pages
b12: g16: 4 ; open
b13: g17: 163 ; first terminal sender;
b14: 0,r.10 ; answer
b15: 0 ; proc addr of main console;
b17: 0 ; for set base
b18: 6<12 ; illegal message to terminal
b19: g18: 1 ; send and wait
b21: g26: 67 ; banker que
b22: g27: 6 ; open chain
b20: 0, 10<12 ; banker operation: get psjob
b24: g28: e13<12+19 ;+4 answer sem
b23: g29: 3 ; lock
b25: e13 ; semafore length
b26: g30: 63 ; first psjob que
b27: 0, 6, 0, r.12; newjob operation to psjob
b28: <:disc:> ; name of disc
b29: g31: 288 ; slicelength on disc
b30: 0 ; bankerop release:
2<12+1 ;+2 code,psjob
0 ;+4 all,stations
1<12;+slices ;+6 entries,slices
0 ;+8 accounts,converts
b31: 0, r.17 ; catalog entry
b32: g32: 74 ; catalog semafor
b33: g33: 78 ; printer answer reservation
b34: g34: 76 ; first of psjob answer semafors
b35: 0, 4 ; attention operation
b36: g35: e13<12+19 ;+4 answer semafore;
\f
; sl 14.7.71 boss 2, unknown sender, ...41...
a1: rl. w2 b1. ; wait:
jl. w3 (b2.) ; lock chain(unknown sender sem);
g3: rl w2 x1+4 ; start corutine: w2:= mess buf addr;
rl w3 x2+8 ; w3:= message-operation
rl w2 x2+6 ; w2:= sender addr;
sh w2 0 ; if sender does not exist then
jl. a2. ; goto reject message;
rl w0 x2 ;
sn w0 0 ; sender.processkind <> internal or
sn w3 0 ; message.operationcode = loginattention then
jl. 4 ; goto attentionmessage else
jl. a3. ; goto internal job;
rl. w3 b13. ; w3:= first terminal sender;
sn. w2 (b15.) ; if sender addr = main console then
jl. a5. ; goto commandio found;
a4: al w3 x3+10 ; rep: w3:= next sender;
rl w0 x3 ;
sn w0 0 ; if sender table.proc addr = 0 then
jl. a5. ; goto commandio found;
se. w3 (b4.) ; if w3 <> last terminal sender then
jl. a4. ; goto rep;
a2: am 1 ; reject message:
a6: al w0 1 ; normal answer: w0:= result;
rl. w3 b3. ; w3:= unknown sender addr;
al w2 0 ; mess addr:=0; allow message.
rx w2 x3+8 ; w2:= old mess addr;
al. w1 b14. ; w1:= answer addr;
jd 1<11+22; send answer;
jl. a1. ; goto wait;
a5: ds. w3 b6. ; commandio found: save proc addr, sender tab;
rs w2 x3 ; sender table.proc addr:= sender addr;
ws. w3 b13. ;
al w2 0 ; w3:= (sender tab addr - first terminal sender)
wd. w3 b7. ; // length of sender tab entry
wm. w3 b8. ; * length of corutine descr
wa. w3 b9. ; + first commio corutine;
rl w0 x3+8 ; w0:= page 1 of current corutine
rl. w3 (b10.) ; := page 1 of commandio;
rs w0 x3+8 ;
jl. w3 (b11.) ; get pages;
rl. w2 b5. ; w2:= saved sender proc addr;
dl w1 x2+4 ;
g4: ds w1 x3+0 ;
dl w1 x2+8 ; copy name to terminal name in page 1;
g5: ds w1 x3+0 ;
al w0 0 ;
; find name table address of sender
rl w1 74 ; w1 := first name table address;
a13: sn w2 (x1) ; rep: if proc descriptions equals then
jl. a14. ; goto sender found;
al w1 x1+2 ; w1 := next name table address;
se w1 (80) ; if name table exhausted then
jl. a13. ; goto reject message
rl. w3 b6. ; else goto rep;
rs w0 x3 ; sender table.proc address := 0;
jl. a2. ;
a14: ; sender found:
g6: rs w1 x3+0 ; save name table address of sender;
rl. w3 (b10.) ;
rs w0 x3+8 ; page 1 descr:= not used;
al. w3 b17. ;
am (66) ;
dl w1 +74 ; set cat base to boss max interval;
jd 1<11+72;
\f
; sl 24.4.72 boss 2, unknown sender, ...42...
rl. w3 b0.+2 ;
j1: al w3 x3+217 ; w3:= terminal name addr;
rl. w2 b5. ;
c.i181 ; suppress reservation att login
se. w2 (b15.) ; if sender addr <> main console then
jd 1<11+8 ; reserve process;
z.
am. (b6.) ;
rl w2 +2 ; w2:= saved sender table.semafor;
al. w1 b35. ; w1:= op;
jl. w3 (b22.) ; open chained(login attention);
rl. w2 b36. ;
jl. w3 (b23.) ; lock answer;
jl. a6. ; goto normal answer;
a3: dl w0 x2+78 ; internal job:
ds. w0 b27.+16; move std int of sender to psjob operation;
rl w2 x1+4 ; w2:= mess buf addr;
dl w0 x2+18 ;
ds. w0 b27.+8 ; move file name from
dl w0 x2+22 ; message to psjob operation;
ds. w0 b27.+12;
bz w0 x2+8 ; w0:=operation code;
se w0 12 ; if not new job then
jl. a8. ; goto remove area;
al. w1 b20. ;
rl. w2 b21. ; open chain(bankerque, get psjob);
jl. w3 (b22.) ;
rl. w2 b24. ;
jl. w3 (b23.) ; lock(answer);
bl. w1 b20.+3 ; w1:= psjob number;
al w0 1 ; w0:= prepare for no psjob idle;
sn w1 0 ; if no psjob idle then
jl. a7. ; goto newjob answer;
al w2 x1-2 ;
wm. w2 b25. ; w2:= (psjob number -2) * semafore length
wa. w2 b26. ; + first psjob queue;
al w3 6 ; op.2 := internal job
rl. w0 b24. ;
ds. w0 b27.+4 ; op.4:= answer sem;
; note: rb variables are always cleared
al. w1 b27. ;
jl. w3 (b22.) ; open chain(psjob que, newjob operation);
rl. w2 b24. ;
jl. w3 (b23.) ; lock(answer);
bl. w0 b27.+2 ; w0:= result of newjob;
a7: rs. w0 b14. ; newjob answer: store status;
jl. a6. ; goto normal answer;
g19=j1+1 ;
\f
; pm 3.7.72 boss 2, unknown sender, ...43...
a8: se w0 40 ; remove area: if not remove area then
jl. a2. ; goto reject message
dl. w1 b27.+16; set catalogbase to standardbase of sender
al. w3 b17. ;
jd 1<11+72;
se w0 0 ; if result <> 0 then
jl. a10. ; goto test result
al. w3 b27.+6 ; w3:=areaname addr
jd 1<11+52; create areaprocess
se w0 0 ; if result <> 0 then
jl. a9. ; goto test cause
jd 1<11+8 ; reserve process
se w0 0 ; if result <> 0 then
jl. a12. ; goto remove and reject
al. w1 b31. ; lookup head and tail
jd 1<11+76;
se w0 0 ; if result <> 0 then
c.-1, o84, z. ; (bossfault xref)
jd -84 ; bossalarm
rl. w0 b31. ; if not scope temp then
sz w0 6 ;
jl. a12. ; goto remove and reject
rl. w1 b31.+14; w1:=size
sh w1 -1 ; if size<0 then
al w1 0 ; w1:=0
al w0 0 ;
wd. w1 b29. ; w1:=size//discslicelength
se w0 0 ; if size mod discslicelength <> 0 then
al w1 x1+1 ; w1:=w1+1
hs. w1 b30.+7 ; bankeroprelease.slice:=w1
sh w1 0 ; if w1>0 then
jl. a11. ; begin
dl. w1 b31.+18; if documentname <> <:disc:> then
sn. w0 (b28.) ;
se. w1 (b28.+2);
jl. a12. ; goto remove and reject
; end
\f
; pm 3.7.72 boss 2, unknown sender, ...44...
a11: al. w1 b14.+2 ; send normal answer
al w3 0 ; allow messages
am. (b3.) ;
rs w3 +8 ;
al w0 1 ;
jd 1<11+22;
rl. w2 b32. ; lock(catalog semafor)
jl. w3 (b23.) ;
dl. w1 b27.+16; set catalogbase
al. w3 b17. ;
jd 1<11+72;
al. w3 b31.+6 ; remove entry
jd 1<11+48;
rl. w2 b32. ; open(catalog semafor)
jl. w3 (b12.) ;
rl. w2 b33. ; lock(printer answer reservation)
jl. w3 (b23.) ;
rl. w2 b21. ; open chain(banker, release)
al. w1 b30. ;
jl. w3 (b22.) ;
rl. w2 b34. ; lock(printer answer)
al w2 x2+e13 ;
jl. w3 (b23.) ;
rl. w2 b33. ; open(printer answer reservation)
jl. w3 (b12.) ;
jl. a1. ; goto wait
a9: sl w0 3 ; test cause: if hard error then
jl. a2. ; bossalarm else goto reject message
c.-1, o85, z. ; (bossfault xref)
jd -85 ;
a10: sl w0 4 ; test result: if hard error then
c.-1, o86, z. ; (bossfault xref)
jd -86 ; bossalarm else goto reject message
jl. a2. ;
a12: jd 1<11+64; remove and reject: remove process
jl. a2. ; goto reject message
e. ; end code and variable page
g1=k-g0 ;
\f
; sl 14.7.71 boss 2, unknown sender, ...45...
g7: 3<15+e83<12 + g3-g0; initial test mode, start relative
g20: e12<12+ 18 ; reserve one corutine descr
g21: 217 ; terminal name
g22: 14 ; simulate lock
g23: 12 ; reserve virtual
g24: 13 ; move to virtual
g25: 15 ; end init
g8: 0,0,0,0 ; work, process name
g2: rl. w1 b13. ; start init:
al w1 x1+10*i4 ; last terminal sender:= first terminal sender
rs. w1 b4. ; + number of commios * 10 - 10;
rl. w1 g21. ;
al w1 x1+2 ;
hs. w1 g4.+1 ;
al w1 x1+4 ; set rel addresses of terminal name;
hs. w1 g5.+1 ;
al w1 x1+2 ;
hs. w1 g6.+1 ;
rl w2 74 ;
rl w2 x2+i1<1 ; w2:= proc addr of main console;
dl w1 x2+4 ;
ds. w1 g8.+2 ; copy name of main console
dl w1 x2+8 ;
ds. w1 g8.+6 ;
al. w3 g8. ;
jd 1<11+4 ; get process addr;
rs. w0 b15. ; differs from w2 under simulation.
rl. w2 b1. ; w2:= addr of unknown sender sem;
am. (b3.) ;
rs w2 +2 ; sender table.sem addr:= w2;
rl. w1 g20. ;
jl. w3 (g22.) ; simulate lock
al w0 i61 ;
al w1 g1 ;
jl. w3 (g23.) ; reserve virtual
al w2 x2+1 ; write page
al. w0 g0. ;
jl. w3 (g24.) ; move to virt
rl. w1 g7. ;
am. (g20.) ;
ds w2 +6 ; set start addr and page 0
am.(4,jl.4,h5.) ; goto initialize tinitcat;
i.e.
\f
; lkn remote batch ...46...
; this code page contains procedures for communicating with the net supervisor
; process, named <host>
;
; the procedures are:
;
; lookup host gets the description of the device host corresponding
; to a link process
;
; lookup device checks whether or not a device matching the device
; description, is connected to the specified host
;
; lookup and reserve device
; as lookup device and if the device exists a link
; is created and the link process is reserved
;
;
;
;
; initialization:
s. b100, c100, f100, g100 w.
h8=h7. ; external table
g10., g11., g12., g13., g14., g15.
0
b. a10 w.
al w0 i64 ; start initialization
al w1 g1 ;
jl. w3 (g10.) ; reserve virtual
al. w0 b0. ;
jl. w3 (g11.) ; move to virtual
rs. w2 a1. ; set virtual address of code page
jl. w3 (2) ; set externals
g12: 40 ;
a1: 0 , 140 ; virt of code
g20, 141 ; rel lookup and reserve
g21, 142 ; rel lookup device
g25, 146 ; rel lookup host
0 , -1000 ; end of externals
am. (4) ;
jl. 4 ; goto initialize unknown sender
h7. ;
e.
g10: 12 ; reserve virtual
g11: 13 ; move to virtual
\f
; lkn remote batch ...47...
; definition of various formats:
;
; message format:
f0 = 0, f1 = 1 ;+0 operation , function mode<1 + address mode
f2 = 2 ;+2 first of operation
f3 = 4 ;+4 last of operation
f4 = 6, f5 = 7 ;+6 dh. linkno , dh. hostno ( or process description )
f6 = 8 ;+8 dh. hostid
f7 =10, f8 =11 ;+10 dh. homereg , dh. netid
; operation format (input or output to or from <host>)
f20= 0, f21= 1 ;+0 mode , kind
f22= 2, f23= 3 ;+2 timeout , buffers
f24= 4 ;+4 buffer size
f25= 6 ;+6 device name
;+8 -
;+10 -
;+12 -
f26=14 ;+14 unused
f27=16 ;+16 jh. hostid
f28=18, f29=19 ;+18 jh. homereg , jh. netid
f30=20 ;+20 process description
; answer format:
f40= 0 ;+0 device status < 16 + link descriptor < 12 + return value
f41= 2 ;+2 bytes
f42= 4 ;+4 characters
f43= 6, f44= 7 ;+6 dh. linkno , dh. hostno
f45= 8 ;+8 dh. hostid
f46=10, f47=11 ;+10 dh. homereg , dh. netid
\f
; lkn remote batch ...48...
; start of code page
b0: 0 ; page 0
b1: 0 ; page 1: contains parameters
b2: 0 ; page 2
b3: 0 ; page 3
b4: 0 ; page 4: job description page at search and define device
84<12+0; page identification
b10: 1<12, 0,r.7 ; message area
b11: 0,r.5 ; name of process, name table address
b12: g13: 1 ; send and wait
b13: g14: 8 ; page jump
b14: g15: 21 ; coruno output
b20: <:printer:>,0 ; some printer is converted to the name <printer>
b22: <:host:>,0,0,0 ; name of host process
b23: 0 ; work
b24: 15 ; mask
b25: (:-1:)>1 ; mask1
b26: 97<16-1 ; base of legal name formats
b27: 3 ; characters per word
\f
; lkn remote batch ...49...
; lookup host:
;
; call and return parameters as described in options (page 7b)
; error return: device locally connected
;
; this procedure sends a lookup message to <host> to get the description of the
; device host corresponding to the link process pointed out
b. a10 w.
c0: rl w2 x3+r40 ; lookup host:
jl. w1 c20. ; clear message area
al w0 4<6+12 ;
al w1 x3+r40 ;
jl. w3 (b14.) ; testout(call parameters)
al w0 2<1+1 ;
hs. w0 b10.+f1; function mode:=lookup process
rl w2 x3+r40 ;
rs. w2 b10.+f2; set first,
al w2 x2+f30 ;
rs. w2 b10.+f3; last of operation area
rl w0 x3+r41 ;
rs. w0 b10.+f4; set process description address
al w0 16<6+12;
al. w1 b10. ;
jl. w3 (b14.) ; testout(message)
al. w1 b10. ; w1:=abs ref message
al. w2 b22. ;
jl. w3 (b12.) ; send and wait lookup process
so w0 1<1 ; if result <> 1
jl. c14. ;
al w0 16<6+12;
rs. w1 b23. ; save answer reference
jl. w3 (b14.) ; testout(answer)
rl. w1 b23. ;
bz w0 x1+f40+1 ; or return value <> 0
se w0 0 ;
jl. c15. ; then goto error return
bz w0 x1+f40 ;
la. w0 b24. ;
se w0 1 ; if not connected as rb device
jl. c15. ; then goto error return
dl w1 x1+f45 ; set dh.linkno < 12 + hostno,
ds w1 x3+r142+2 ; dh. hostid
al w0 22<6+12;
rl w1 x3+r40 ;
jl. w3 (b14.) ; testout(host input)
jl. c10. ; goto normal return
e.
\f
; lkn remote batch ...50...
; lookup device:
;
; call and return parameters as described in options (page 7b)
; error return: device not found
;
; this procedure sends a lookup message to host to get a total description of
; a device at a specified host
b. a10 w.
c6: rs. w1 b23. ; set lookup operation:
al w0 22<6+12;
al w1 x3+r0 ;
jl. w3 (b14.) ; testout(call parameters)
rl w0 x3+r1 ; if device = some printer
se w0 1 ; then
jl. a1. ; begin
dl. w1 b20.+2 ; device name:=<:printer:>
ds w1 x3+r1+2 ;
dl. w1 b20.+6 ;
ds w1 x3+r1+6 ;
al w0 14; mode is unchanged (=option i185) ; device kind:=14
hs w0 x3+r4 ; end
a1: rl w2 x3+r0 ; w2:=message area
jl. w1 c20. ; clear message area
rs. w2 b10.+f2; set first,
al w0 x2+f30 ;
rs. w0 b10.+f3; last of message area,
dl w1 x3+r2+2 ; dh. linkno < 12 + hostno
ds. w1 b10.+f6; dh. hostid
al w0 0 ;
rs. w0 b10.+f7; homereg < 12 + netid := 0
rl w0 x3+r3 ; set host output:
rs w0 x2+f20 ; mode, kind
dl w1 x3+r1+2 ;
ds w1 x2+f25+2 ; device name
dl w1 x3+r1+6 ;
ds w1 x2+f25+6 ;
al w0 16<6+12;
al. w1 b10. ;
jl. w3 (b14.) ; testout(message)
al w0 22<6+12;
rl w1 x3+r0 ;
jl. w3 (b14.) ; testout(host output)
jl. (b23.) ; return
\f
; lkn remote batch ...51...
c1: al w0 3<1 ; lookup device:
hs. w0 b10.+f1; function mode:=lookup
jl. w1 c24. ; lookup device name in catalog
jl. w1 c6. ; set operation
al. w1 b10. ; w1:= abs ref message area
al. w2 b22. ; w2:=receiver name
jl. w3 (b12.) ; send and wait (lookup)
so w0 1<1 ; if result <> 1
jl. c14. ;
al w0 16<6+12;
rs. w1 b23. ; save answer reference
jl. w3 (b14.) ; testout(answer)
rl. w1 b23. ;
bz w0 x1+f40+1 ;
se w0 0 ; if return value <> 0
jl. c14. ; then goto error return
bz w0 x1+f40 ;
la. w0 b24. ;
sl w0 2 ; if not free or connected as rb device then
jl. c14. ; then goto error return
al w0 22<6+12;
rl w1 x3+r0 ;
jl. w3 (b14.) ; testout(host input)
al w0 0 ;
rs w0 x3+r102 ; set device no = 0
c7: rl w2 x3+r0 ; set return parameters
rs w0 x3+r101 ; return value,
bz w0 x3+r3 ;
sh w0 -1 ; if mode(call)=dummy
bz w0 x2+f20 ; then take return mode
rs w0 x3+r103 ; mode,
bz w0 x3+r4 ;
sh w0 -1 ; if kind(call)=dummy
bz w0 x2+f21 ; then take return kind
rs w0 x3+r104 ; kind,
al w0 0 ;
rl w1 x2+f24 ; w0w1:= max buffer size (chars)
wd. w1 b27. ; w1:= max buffer size (words)
ls w1 1 ; w1:= max buffer size (bytes)
rs w1 x3+r106 ; set max buffer size
al w0 10<6+12;
al w1 x3+r101 ;
jl. w3 (b14.) ; testout(return parameters)
jl. c10. ; goto normal return
e.
\f
; lkn remote batch ...52...
; lookup and reserve device
;
; call and return parameters as described in options (page 7b)
; error return: result = 1 unknown
; = 2 reserved by other host
; = 3 no resources
; = 4 time exceeded
; = 7 reserved by other process in job host
; > 7 nta of process reserved by boss
;
; this procedure creates a link process to a specified device at a specified host
; and reserves the link process
b. a10 w.
c2: al w0 6<1 ; lookup and reserve device:
hs. w0 b10.+f1; function mode:=link up remote
jl. w1 c24. ; lookup device name in catalog
jl. w1 c6. ; set lookup operation
rl w2 x3+r0 ;
rl w0 x3+r5 ;
hs w0 x2+f22 ; set timeout
al. w1 b10. ; w1:=abs ref message
al. w2 b22. ; w2:=receiver
jl. w3 (b12.) ; send and wait (link up remote)
so w0 1<1 ; if result <> 1
jl. c14. ;
al w0 16<6+12;
rs. w1 b23. ; save answer reference
jl. w3 (b14.) ; testout(answer)
rl. w1 b23. ;
bz w0 x1+f40+1 ; or return value <> 0
se w0 0 ;
jl. c13. ; then goto error return
bz w0 x1+f40 ;
la. w0 b24. ;
se w0 1 ; if not connected as rb device then
jl. c14. ; goto error return
al w0 22<6+12;
rl w1 x3+r0 ;
jl. w3 (b14.) ; testout(host input)
rl w2 x3+r0 ;
rl w2 x2+f30 ; w2:=process description address
jl. w1 c21. ; check reservation
jl. c12. ;+2 reserved by other process
jl. c11. ;+4 reserved by boss
al. w3 b11. ;
dl w1 x2+4 ; move process name
ds w1 x3+2 ;
dl w1 x2+8 ;
ds w1 x3+6 ;
jd 1<11+8 ; reserve process
rl. w3 b1. ;
sn w0 0 ; if result = 0 then goto set return parameters
jl. a0. ;
se w0 1 ; if result = 1 then device unknown
al w0 7 ; else device reserved by other process
jl. c15. ; goto error return
a0: rl w1 74 ;
al w1 x1-2 ; w1:=base of devices in name table
a1: al w1 x1+2 ; w1:=next device
rl w0 x1 ; w0:=process description address
se w0 x2 ; if w0 <> w2
jl. a1. ; then goto next
al w0 x1 ;
ws w1 74 ;
ls w1 -1 ; w1:=rc device no
rs w1 x3+r102 ; save device no
jl. c7. ; set rest of return parameter
e.
\f
; lkn remote batch ...53...
; return from rb procedures
b. a10 w.
c10: dl w3 x3+2 ; normal return:
al w3 x3+2 ;
jl. (b13.) ; return to link+2
c11: am x2-7 ; device reserved by boss
c12: al w0 7 ; device reserved by other process
jl. c15. ;
c13: se w0 1 ; if return value=1 then
jl. a1. ; begin
bz w1 x1+f40 ;
ls w1 -4 ; w1:=device status
jl. a2. ; end
a1: sl w0 4 ; if return value > 4
al w0 4 ; then return value := 4
sh w0 0 ; if return value < 0
c14: al w0 1 ; then return value:=1 (=device unknown)
c15: al w1 0 ;
a2: rs w0 x3+r100 ; set return value
rs w1 x3+r100+2 ; set device status
al w0 4<6+12 ;
al w1 x3+r100 ;
jl. w3 (b14.) ; testout(return value)
dl w3 x3+2 ;
jl. (b13.) ; error return to link
e.
\f
; lkn remote batch ...54...
; clear message area
; sets dummy values for all fields in <host output>
;
; call: return:
; w0 = irr. w0 = destr.
; w1 = return w1 = unch.
; w2 = abs ref message area w2 = unch.
; w3 = irr. w3 = unch.
b. a10 w.
c20: al w0 -1 ; clear message area:
hs w0 x2+f20 ; -1: mode,
hs w0 x2+f21 ; kind,
rs w0 x2+f30 ; process description
al w0 0 ;
rs w0 x2+f27 ; 0: jh. hostid
rs w0 x2+f28 ; jh. homereg < 12 + jh. netid
hs w0 x2+f22 ; timeout
rs w0 x2+f25 ; device name
al w0 1 ;
hs w0 x2+f23 ; 1: buffers
al w0 2046 ;
rs w0 x2+f24 ; >>0: buffer size
jl x1 ; return
e.
; check reservation
; checks the reserver word of the process description referenced by w2
;
; call: return:
; w0 = irr. w0 = destr.
; w1 = return w1 = destr.
; w2 = process description w2 = unch.
; w3 = abs ref page 1 w3 = unch.
b. a10 w.
c21: al w1 x1+4 ; save link+4 as return
rs. w1 b23. ;
rl w0 x2+12 ; w0:=reserver of process
sn w0 0 ; if no reserver
jl. (b23.) ; then return to link+4
rl. w1 b23. ; w1:=link+4
am (66) ;
se w0 (+12) ; if reserver <> boss
al w1 x1-2 ; then return to link
jl x1-2 ; else return to link+2
e.
\f
; lkn remote batch ...55...
; lookup device name in catalog
; if the device name specified in the call parameters for lookup, lookup reserve
; and search lookup corresponds to to a file descriptor in the main catalog,
; then the mode kind and the document name from this file descriptor is
; used for the the operations sent to <:host:>
;
; call: return:
; w0 = irr. w0 = destr.
; w1 = return w1 = destr.
; w2 = irr. w2 = destr.
; w3 = page 1 abs w3 = unch.
b. a10 w.
c24: rs. w1 b23. ; lookup device name in catalog;
rl w0 x3+r1 ; w0:=first of name
sh. w0 (b26.) ; if name format illegal
jl x1 ; then return
dl w1 x3+r6+2 ;
al w1 x1+1 ; upper=upper proj+1
al. w3 b22.+4 ; w3:=abs ref 0
jd 1<11+72; set own catalog base
rl. w3 b1. ; w3:=abs ref page 1
al. w1 a1. ; w1:=abs ref catalog entry buffer
al w3 x3+r1 ; w3:=abs ref device name
jd 1<11+76; lookup entry head and tail
al w3 x3-r1 ;
rl w2 x1+14 ; w2:=mode,kind
sn w0 0 ; if entry not found
sl w2 0 ; or entry describes an area
jl. (b23.) ; then return
rl w0 x1 ;
la. w0 a0. ; if entry not permanent
se w0 3 ;
jl. (b23.) ; then return
la. w2 b25. ; remove 1<23
rs w2 x3+r3 ; set mode,kind in call parameters
al w2 x1+14 ;
dl w1 x2+4 ; device name (call parameters)
ds w1 x3+r1+2 ; := document name (file descriptor)
dl w1 x2+8 ;
ds w1 x3+r1+6 ;
dl w1 x2+14 ; w0,w1:=host description from catalog entry
sn w0 0 ; if descriptor not default (=0,0)
se w1 0 ; then
ds w1 x3+r2+2 ; overwrite host description(call parameters)
jl. (b23.) ; return
a0: 7 ; mask for extracting catalog key
a1: 0,r.17 ; catalog entry buffer
e.
g1 =k-b0 ; length of code page
g20=c2-b0 ; rel entry lookup and reserve
g21=c1-b0 ; rel entry lookup
g25=c0-b0 ; rel entry lookup host
i.
e. ; end remote batch page
e.e. ; end tpsjobdescr
h11=s0, h12=s1 ; final chech sums
e.e.e. ; end h-names, options, tprocs
\f
▶EOF◀