|
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: 380160 (0x5cd00)
Types: TextFile
Names: »mon8part4«
└─⟦a8311e020⟧ Bits:30003039 RC 8000 Monitor Kildetekst
└─⟦9ab0fc1ed⟧
└─⟦this⟧ »mon8part4«
17298 17992 \f 17298 17992 17298 17992 \f 17298 17992 17298 17992 m. 17298 17992 montabinit - monitor table initialisation ..... and procfunc 17299 17992 17299 17992 b.i30 w. 17300 17992 i0=82 02 08, i1=15 00 00 17301 17992 17301 17992 ; if newtime (i0,i1) > oldtime (a133,a134) then oldtime:=newtime; 17302 17992 c.i0-a133 17303 17992 c.i0-a133-1, a133=i0, a134=i1, z. 17304 17992 c.i1-a134-1, a134=i1, z. 17305 17992 z. 17306 17992 17306 17992 i10=i0, i20=i1 17307 17992 17307 17992 i15=i10/100000 , i10=i10-i15*100000 , i25=i20/100000 , i20=i20-i25*100000 17308 17992 i14=i10/10000 , i10=i10-i14*10000 , i24=i20/10000 , i20=i20-i24*10000 17309 17992 i13=i10/1000 , i10=i10-i13*1000 , i23=i20/1000 , i20=i20-i23*1000 17310 17992 i12=i10/100 , i10=i10-i12*100 , i22=i20/100 , i20=i20-i22*100 17311 17992 i11=i10/10 , i10=i10-i11*10 , i21=i20/10 , i20=i20-i21*10 17312 17992 17312 17992 i2: <: date :> 17313 18016 (:i15+48:)<16+(:i14+48:)<8+46 17314 18018 (:i13+48:)<16+(:i12+48:)<8+46 17315 18020 (:i11+48:)<16+(:i10+48:)<8+32 17316 18022 17316 18022 (:i25+48:)<16+(:i24+48:)<8+46 17317 18024 (:i23+48:)<16+(:i22+48:)<8+46 17318 18026 (:i21+48:)<16+(:i20+48:)<8+ 0 17319 18028 17319 18028 i3: al. w0 i2. ; write date: 17320 18030 rs w0 x2+0 ; first free:=start(text); 17321 18032 al w2 0 ; 17322 18034 jl x3 ; return to slang(status ok); 17323 18036 17323 18036 jl. i3. ; 17324 18038 e. 17325 18038 j. 17325 17992 date 82.02.08 15.00.00 17326 17992 17326 17992 17326 17992 17326 17992 b.i0 ; begin 17327 17992 w.i0: al. w2 i0. ; make room: 17328 17994 jl x3+0 ; autoloader(end external processes); 17329 17996 jl. i0. ; after loading: 17330 17998 g70= k-b127 + 2 17331 17998 k = i0 ; goto make room; 17332 17992 e. ; end 17333 17992 h3=g2, h4=g2, h5=g2, h6=g2, h7=g2, h8=g2, h9=g2 17334 17992 h10=g2, h11=g2, h12=g2, h13=g2, h14=g2, h15=g2, h16=g2, h17=g2, h18=g2, h19=g2 17335 17992 h20=g2, h21=g2, h22=g2, h25=g2, h26=g2, h29=g2 17336 17992 h30=g2, h31=g2, h32=g2, h33=g2, h34=g2, h35=g2, h38=g2, 17337 17992 17337 17992 e. ; end of external process segment 17338 17992 \f 17338 17992 17338 17992 17338 17992 17338 17992 ; segment 4: process descriptions 17339 17992 s. k=k, h25, g300, e50, j20 17340 17992 w. b127=k, h25, k=k-2 17341 17992 17341 17992 ; name table: 17342 17992 ; the table has one entry for each process description. 17343 17992 ; an entry contains the address of the corresponding 17344 17992 ; process description. 17345 17992 17345 17992 w. 17346 17992 f0: ; name table start: 17347 17992 h22 ; remoter process 17348 17994 h23 ; host process 17349 17996 h24 ; clock process 17350 17998 f18 ; errorlog process 17351 18000 f1: ; first device 17352 18000 t. 17352 18000* type 17353 18000 17353 18000 m. 17353 18000 name table 17354 18000 17354 18000 g0 , g1 , g2 , g3 , g4 , g5 , g6 , g7 , g8 , g9 17355 18020 g10 , g11 , g12 , g13 , g14 , g15 , g16 , g17 , g18 , g19 17356 18040 g20 , g21 , g22 , g23 , g24 , g25 , g26 , g27 , g28 , g29 17357 18060 g30 , g31 , g32 , g33 , g34 , g35 , g36 , g37 , g38 , g39 17358 18080 ; g40 , g41 , g42 , g43 , g44 , g45 , g46 , g47 , g48 , g49 17359 18080 ; g50 , g51 , g52 , g53 , g54 , g55 , g56 , g57 , g58 , g59 17360 18080 ; g60 , g61 , g62 , g63 , g64 , g65 , g66 , g67 , g68 , g69 17361 18080 ; g70 , g71 , g72 , g73 , g74 , g75 , g76 , g77 , g78 , g79 17362 18080 ; g80 , g81 , g82 , g83 , g84 , g85 , g86 , g87 , g88 , g89 17363 18080 ; g90 , g91 , g92 , g93 , g94 , g95 , g96 , g97 , g98 , g99 17364 18080 17364 18080 n.m. 17364 18080 monitor device list in name table included 17365 18080 f2: ; first area 17366 18080 h7, r.a1 ; area part 17367 18346 f3: ; first internal 17368 18346 h8, r.a3 ; internal part 17369 18368 f4: c98 ; name table end (used by search name) 17370 18370 17370 18370 f13: ; first drum chain 17371 18370 c.(:a113-1:),h9,r.a113,z. 17372 18370 f14: ; first disc chain 17373 18370 c.(:a115-1:),h10,r.a115,z. 17374 18378 f15: 0 ; chain end 17375 18380 17375 18380 17375 18380 ; dummy internal process: 17376 18380 17376 18380 f5=k-a16 ; start of dummy process 17377 18380 b2, b2 ; timer q links: initially single in queue 17378 18384 r.(:a17-a16-2:)>1 17379 18384 h1, h2 ; first, top of process 17380 18388 r.(:a19-a18:)>1 17381 18388 0<12+0 ; claims 17382 18390 0<12+0 ; 17383 18392 r.(:a301-a21:)>1 17384 18392 1<23 - 3 ; priority = almost greatest integer 17385 18394 r.(:a27-a301:)>1 17386 18398 h1 ; interrupt address 17387 18400 r.(:a170-a27:)>1 17388 18400 h1 ; escape address 17389 18402 0 ; all params 17390 18404 r.(:a28-a171:)>1 17391 18442 ; the following sequence will be executed in the registers, 17392 18442 ; until a technical panel is mounted, and data-switches all zero: 17393 18442 gg w3 b97 ; test for panel: 17394 18444 se w3 0 ; if data-switches <> 0 then 17395 18446 jl 0 ; goto test for panel; 17396 18448 0 ; (i.e. when panel and dswr=0: an exception will occur here) 17397 18450 r.(:a32-a31:)>1 17398 18450 1<23 ; status 17399 18452 r.(:a33-a32:)>1 17400 18452 h0 ; ic 17401 18454 r.(:a181-a33:)>1 17402 18458 8 ; cpa 17403 18460 0 ; base 17404 18462 8 ; lower write limit 17405 18464 2047<12 ; upper write limit 17406 18466 b54 ;+0<12 ; interrupt levels 17407 18468 r.(:a302-a185:)>1 17408 18468 0 ; save area address 17409 18470 r.(:a303-a302:)>1 ; (fill up for save area, used during upstart) 17410 18484 m. 17410 18484 dummy internal reg dump 17411 18484 17411 18484 b. i10, j10 w. 17412 18484 h0: gg w3 b100 ; test for rc8000 type: 17413 18486 sh w3 0 ; if type <> 55 then the dummy loop 17414 18488 jl 0 ; is executed in the working registers, 17415 18490 jl. +0 ; otherwise in core. 17416 18492 ; when an exception occurs, registers will be dumped here: 17417 18492 h1: 0, r. a180>1 ; register dump 17418 18508 dl. w3 j0. ; get loop-count; 17419 18510 rs. w3 h1.+a33-a28; prepare for resuming the quick-loop: ic := 0; 17420 18512 17420 18512 i0: ; check for stability of the zero: 17421 18512 gg w0 b97 ; if the dataswitches are not stable for 17422 18514 se w0 0 ; some period then 17423 18516 re. h1. ; resume the register-loop; 17424 18518 al w2 x2-1 ; (i.e. a short period of zeroes will not 17425 18520 se w2 0 ; destroy the algorithm) 17426 18522 jl. i0. ; goto check for stability; 17427 18524 17427 18524 i1: ; technical-panel loop: 17428 18524 gg w0 b98 ; w0 := regsel switches; 17429 18526 gg w1 b97 ; w1 := dswr register; 17430 18528 sn w1 -1 ; if dswr = all ones 17431 18530 so w0 2.111111<1; 17432 18532 jl. i2. ; and regsel = all ones then 17433 18534 re. h1. ; resume register-loop; 17434 18536 17434 18536 i2: sz w0 1<1 ; if no-display bit then 17435 18538 jl. i1. ; goto normal loop; 17436 18540 17436 18540 sl w1 8 ; if legal core-address then 17437 18542 sl w1 (b12) ; begin 17438 18544 jl. i3. ; 17439 18546 di w2 x1 ; display(core(w1)); 17440 18548 gp w2 b99 ; goto normal loop; 17441 18550 jl. i1. ; end; 17442 18552 17442 18552 i3: ; not legal address: 17443 18552 ; used for displaying the cpu-load 17444 18552 al w2 0 ; 17445 18554 rl w3 b11 ; cputime := slice 17446 18556 aa. w3 f5.+a36+2; + runtime.dummyprocess; 17447 18558 ; (notice: if the dummy process is interrupted 17448 18558 ; between the above two instructions, 17449 18558 ; the cputime may not be consistent, 17450 18558 ; but this is not considered any harm) 17451 18558 ss. w3 j1. ; 17452 18560 al w0 a85 ; if cputime is not updated 17453 18562 ls w0 x1 ; enough then 17454 18564 sl w0 x3 ; goto normal loop; 17455 18566 jl. i1. ; 17456 18568 17456 18568 ds. w3 j2. ; cpu incr := new cpu time - old cpu time; 17457 18570 aa. w3 j1. ; old cpu time := new cpu time; 17458 18572 ds. w3 j1. ; 17459 18574 17459 18574 ; get real-time increment: 17460 18574 dl w3 b13+2 ; 17461 18576 dl. w1 j3. ; real incr := new time - old time; 17462 18578 ds. w3 j3. ; old time := new time; 17463 18580 ss w3 2 ; 17464 18582 17464 18582 dl. w1 j2. ; 17465 18584 nd w1 3 ; 17466 18586 nd w3 7 ; 17467 18588 fm. w1 j4. ; 5pct := cpu incr * 20.0 17468 18590 fd w1 6 ; div(real incr); 17469 18592 17469 18592 cf w1 0 ; 17470 18594 17470 18594 ; take some kind of arithmetic mean: 17471 18594 ws. w1 j5. ; 17472 18596 as w1 -1 ; 17473 18598 wa. w1 j5. ; 5pct := (5pct - old 5pct) shift (- xx) 17474 18600 rs. w1 j5. ; + old 5pct; 17475 18602 17475 18602 al w0 -1 ; 17476 18604 ls w0 x1+4 ; display( (-1) shift (5pct + 4) ); 17477 18606 rl. w2 j6. ; flicker := flicker shift (-1); 17478 18608 ls w2 -1 ; 17479 18610 sn w2 0 ; if no bits left in flicker then 17480 18612 al w2 1<3 ; flicker := 1 shift 3; 17481 18614 rs. w2 j6. ; (i.e. flicker is one out of four bits to the rigth) 17482 18616 wa w0 4 ; add flicker to cpuload; 17483 18618 gp w0 b99 ; (i.e. use the leftmost 20 bits, 5 pct each) 17484 18620 jl. i1. ; goto normal loop; 17485 18622 17485 18622 j0=k+2, 100000, 0 ; loopcount, zero 17486 18626 j1=k+2, 0, 0 ; old cpu time 17487 18630 j2=k+2, 0, 0 ; cpu incr 17488 18634 j3=k+2, 0, 0 ; old time 17489 18638 f. 17490 18638 j4: 20.0 ; 5-pct factor 17491 18642 w. 17492 18642 j5: 0 ; old 5pct 17493 18644 j6: 0 ; flicker 17494 18646 e. ; end of dummy process 17495 18646 h2=k ; top of dummy process 17496 18646 \f 17496 18646 17496 18646 17496 18646 17496 18646 ; external processes. 17497 18646 17497 18646 ; dummy external process: 17498 18646 17498 18646 0,0,0,0,0 17499 18656 0,r.4,-4 17500 18666 jl w2 c51,k,k-2,0,0,jl (b20) 17501 18678 0,0,0 17502 18684 h4: 00,<:<0><0><0>dummy:>,0 17503 18694 0,0,0,k,k-2,0 17504 18706 17504 18706 ; remoter process: 17505 18706 17505 18706 0,a107,a108-1 17506 18712 h22: 56,<:remoter:>,0 17507 18722 0,0,-1,k,k-2,0 17508 18734 17508 18734 ; host process: 17509 18734 17509 18734 0,a107,a108 17510 18740 h23: 90,<:host:>,0,0 17511 18750 0,0,0,k,k-2,0 17512 18762 17512 18762 ; clock process: 17513 18762 17513 18762 0,0,0,0,0 17514 18772 0,r.4,0 17515 18782 jl w2 c50,k,k-2,0,c35,jl w1 c30 17516 18794 0,a107,a108-1 17517 18800 h24: 02,<:clock:>,0,0 17518 18810 0,0,0,k,k-2,0 17519 18822 17519 18822 17519 18822 ; errorlog process 17520 18822 0,a107,a108-1 17521 18828 f18 : 54, <:errorlog:>,0 17522 18838 0,0,0,k,k-2,0 17523 18850 0,r.40 17524 18930 17524 18930 17524 18930 17524 18930 ; peripheral processes: 17525 18930 f19=k ; start 17526 18930 t. 17526 18930* type 17527 18930 17527 18930 m. 17527 18930 process descriptions 17528 18930 17528 18930 b.j1 w. 17529 18930 m. 17529 18930 start of testbuffer 17530 18930 j0=k, 0, r.512, j1=k 17531 19954 m. 17531 19954 top of testbuffer 17532 19954 0, a107, a108-1 17533 19960 m. 17533 19960 main1 17534 19960 g14: 80, <:main1:> , 0, 0, g14, 0, 1<22, k, k-2, 0 17535 19982 j0, j1, j0, j1 17536 19990 8.7777 7777, 8.7376 7777, 8.7777 7777, 8.7777 7777 17537 19998 0, k, k-2, 0, 0, a124<16+a125 17538 20010 0, r.56 17539 20122 e. 17540 20122 17540 20122 17540 20122 b.j1 w. 17541 20122 000, 000, 0, j0, j1, 0, r.4, 1<23+2<3 17542 20142 jl w2 c51, k, k-2, 0, c43, jl w1 c30 17543 20154 0, a107, a108-1 17544 20160 m. 17544 20160 fparec1 17545 20160 g15: 86, <:fparec1:> , 0, g14, 0, 1<22, k, k-2, 0 17546 20182 0, r.15, 500 17547 20214 0, r.5 17548 20224 j0=k-g15, 0, r.21, j1=k-g15 17549 20266 e. 17550 20266 17550 20266 17550 20266 b.j1 w. 17551 20266 000, 000, 0, j0, j1, 0, r.4, 1<23+3<3 17552 20286 jl w2 c51, k, k-2, 0, c44, jl w1 c30 17553 20298 0, a107, a108-1 17554 20304 m. 17554 20304 fpatrm1 17555 20304 g16: 88, <:fpatrm1:> , 0, g14, 0, 1<22, k, k-2, 0 17556 20326 0, r.14, 100 000, 1000 17557 20358 0, r.13 17558 20384 j0=k-g16, 0, r.21, j1=k-g16 17559 20426 e. 17560 20426 17560 20426 17560 20426 0, a107, a108-1 17561 20432 m. 17561 20432 host1 17562 20432 g17: 82, 0, r.4, g14, 0, 1<23+1<22, k, k-2, 0 17563 20454 0, r.6 17564 20466 0<12+17, -2<12+0, 0, k, k-2, 16<12+0, 24, a123<12+a124, a125, 0, 0, r.16 17565 20518 0, r.20 17566 20558 17566 20558 g18=h4, g19=h4 17567 20558 17567 20558 g20=h4 17568 20558 17568 20558 17568 20558 0, a107, a108-1 17569 20564 m. 17569 20564 device 21, autoload (unit0, 0 , 1050) 17570 20564 g21: 62, 0, r.4, g28, 0, 1<22, k, k-2, 0 17571 20586 0, r.3, 0, 1050 17572 20596 17572 20596 g22=h4, g23=h4 17573 20596 17573 20596 0, a107, a108-1 17574 20602 m. 17574 20602 device 21050, disc (unit0, 1050 , 42105) 17575 20602 g24: 62, 0, r.4, g28, 0, 1<22, k, k-2, 0 17576 20624 0, r.3, 1050, 21*2005 17577 20634 17577 20634 0, a107, a108-1 17578 20640 m. 17578 20640 device 25, disc1 (unit0, 43155, 42966) 17579 20640 g25: 62, 0, r.4, g28, 0, 1<22, k, k-2, 0 17580 20662 0, r.3, 1050+21*2005, 21*2046 17581 20672 17581 20672 0, a107, a108-1 17582 20678 m. 17582 20678 device 26, disc2 (unit1, 1050, 42105) 17583 20678 g26: 62, 0, r.4, g29, 0, 1<22, k, k-2, 0 17584 20700 0, r.3, 1050, 21*2005 17585 20710 17585 20710 g27=h4 17586 20710 17586 20710 17586 20710 b.j2 w. 17587 20710 j0, j1, 0, j1, j2, 0, r.4, 1<23+4<3 17588 20730 jl w2 c51, k, k-2, 0, c34, jl w1 c30 17589 20742 0, a107, a108-1 17590 20748 m. 17590 20748 discunit0 17591 20748 g28: 62, <:discunit0:>, 0, 000, 0, 1<22, k, k-2, 0 17592 20770 j0=k-g28 17593 20770 0, r.4, 86415, 21, 0, r.5, 1<23, 0, r.32 17594 20858 0, r.41 17595 20940 -1,0,0,-1,0,0,-1,0,0,-1,0,0,-1,0,0 17596 20970 -1,0,0,-1,0,0,-1,0,0,-1,0,0,-1,0,0 17597 21000 j1=k-g28, 0, r.30, j2=k-g28 17598 21060 e. 17599 21060 17599 21060 17599 21060 b.j2 w. 17600 21060 j0, j1, 0, j1, j2, 0, r.4, 1<23+5<3 17601 21080 jl w2 c51, k, k-2, 0, c34, jl w1 c30 17602 21092 0, a107, a108-1 17603 21098 m. 17603 21098 discunit1 17604 21098 g29: 62, <:discunit1:>, 0, 000, 0, 1<22, k, k-2, 0 17605 21120 j0=k-g29 17606 21120 0, r.4, 43155, 21, 0, r.5, 1<23, 0, r.32 17607 21208 0, r.41 17608 21290 -1,0,0,-1,0,0,-1,0,0,-1,0,0,-1,0,0 17609 21320 -1,0,0,-1,0,0,-1,0,0,-1,0,0,-1,0,0 17610 21350 j1=k-g29, 0, r.30, j2=k-g29 17611 21410 e. 17612 21410 17612 21410 0,0,0 17613 21416 m. 17613 21416 device 0 17614 21416 g0: 85,0,r.34 17615 21486 17615 21486 0,0,0 17616 21492 m. 17616 21492 device 1 17617 21492 g1: 85,0,r.34 17618 21562 17618 21562 0,0,0 17619 21568 m. 17619 21568 device 2 17620 21568 g2: 85,0,r.34 17621 21638 17621 21638 0,0,0 17622 21644 m. 17622 21644 device 3 17623 21644 g3: 85,0,r.34 17624 21714 17624 21714 0,0,0 17625 21720 m. 17625 21720 device 4 17626 21720 g4: 85,0,r.34 17627 21790 17627 21790 0,0,0 17628 21796 m. 17628 21796 device 5 17629 21796 g5: 85,0,r.34 17630 21866 17630 21866 0,0,0 17631 21872 m. 17631 21872 device 6 17632 21872 g6: 85,0,r.34 17633 21942 17633 21942 0,0,0 17634 21948 m. 17634 21948 device 7 17635 21948 g7: 85,0,r.34 17636 22018 17636 22018 0,0,0 17637 22024 m. 17637 22024 device 8 17638 22024 g8: 85,0,r.34 17639 22094 17639 22094 0,0,0 17640 22100 m. 17640 22100 device 9 17641 22100 g9: 85,0,r.34 17642 22170 17642 22170 0,0,0 17643 22176 m. 17643 22176 device 10 17644 22176 g10: 85,0,r.34 17645 22246 17645 22246 0,0,0 17646 22252 m. 17646 22252 device 11 17647 22252 g11: 85,0,r.34 17648 22322 17648 22322 0,0,0 17649 22328 m. 17649 22328 device 12 17650 22328 g12: 85,0,r.34 17651 22398 17651 22398 0,0,0 17652 22404 m. 17652 22404 device 13 17653 22404 g13: 85,0,r.34 17654 22474 17654 22474 0,0,0 17655 22480 m. 17655 22480 device 30 17656 22480 g30: 85,0,r.34 17657 22550 17657 22550 0,0,0 17658 22556 m. 17658 22556 device 31 17659 22556 g31: 85,0,r.34 17660 22626 17660 22626 0,0,0 17661 22632 m. 17661 22632 device 32 17662 22632 g32: 85,0,r.34 17663 22702 17663 22702 0,0,0 17664 22708 m. 17664 22708 device 33 17665 22708 g33: 85,0,r.34 17666 22778 17666 22778 0,0,0 17667 22784 m. 17667 22784 device 34 17668 22784 g34: 85,0,r.34 17669 22854 17669 22854 0,0,0 17670 22860 m. 17670 22860 device 35 17671 22860 g35: 85,0,r.34 17672 22930 17672 22930 0,0,0 17673 22936 m. 17673 22936 device 36 17674 22936 g36: 85,0,r.34 17675 23006 17675 23006 0,0,0 17676 23012 m. 17676 23012 device 37 17677 23012 g37: 85,0,r.34 17678 23082 17678 23082 0,0,0 17679 23088 m. 17679 23088 device 38 17680 23088 g38: 85,0,r.34 17681 23158 17681 23158 0,0,0 17682 23164 m. 17682 23164 device 39 17683 23164 g39: 85,0,r.34 17684 23234 c.-1 17685 23234 17685 23234 0,0,0 17686 23234 m. device40 17687 23234 g40: 85,0,r.34 17688 23234 17688 23234 0,0,0 17689 23234 m. device41 17690 23234 g41: 85,0,r.34 17691 23234 17691 23234 0,0,0 17692 23234 m. device42 17693 23234 g42: 85,0,r.34 17694 23234 17694 23234 0,0,0 17695 23234 m. device43 17696 23234 g43: 85,0,r.34 17697 23234 17697 23234 0,0,0 17698 23234 m. device44 17699 23234 g44: 85,0,r.34 17700 23234 17700 23234 0,0,0 17701 23234 m. device45 17702 23234 g45: 85,0,r.34 17703 23234 17703 23234 0,0,0 17704 23234 m. device46 17705 23234 g46: 85,0,r.34 17706 23234 17706 23234 0,0,0 17707 23234 m. device 47 17708 23234 g47: 85,0,r.34 17709 23234 17709 23234 0,0,0 17710 23234 m. device 48 17711 23234 g48: 85,0,r.34 17712 23234 17712 23234 0,0,0 17713 23234 m. device 49 17714 23234 g49: 85,0,r.34 17715 23234 17715 23234 0,0,0 17716 23234 m. device50 17717 23234 g50: 85,0,r.34 17718 23234 17718 23234 0,0,0 17719 23234 m. device51 17720 23234 g51: 85,0,r.34 17721 23234 17721 23234 0,0,0 17722 23234 m. device52 17723 23234 g52: 85,0,r.34 17724 23234 17724 23234 0,0,0 17725 23234 m. device53 17726 23234 g53: 85,0,r.34 17727 23234 17727 23234 0,0,0 17728 23234 m. device54 17729 23234 g54: 85,0,r.34 17730 23234 17730 23234 0,0,0 17731 23234 m. device55 17732 23234 g55: 85,0,r.34 17733 23234 17733 23234 0,0,0 17734 23234 m. device56 17735 23234 g56: 85,0,r.34 17736 23234 17736 23234 0,0,0 17737 23234 m. device 57 17738 23234 g57: 85,0,r.34 17739 23234 17739 23234 0,0,0 17740 23234 m. device 58 17741 23234 g58: 85,0,r.34 17742 23234 17742 23234 0,0,0 17743 23234 m. device 59 17744 23234 g59: 85,0,r.34 17745 23234 17745 23234 0,0,0 17746 23234 m. device60 17747 23234 g60: 85,0,r.34 17748 23234 17748 23234 0,0,0 17749 23234 m. device61 17750 23234 g61: 85,0,r.34 17751 23234 17751 23234 0,0,0 17752 23234 m. device62 17753 23234 g62: 85,0,r.34 17754 23234 17754 23234 0,0,0 17755 23234 m. device63 17756 23234 g63: 85,0,r.34 17757 23234 17757 23234 0,0,0 17758 23234 m. device64 17759 23234 g64: 85,0,r.34 17760 23234 17760 23234 0,0,0 17761 23234 m. device65 17762 23234 g65: 85,0,r.34 17763 23234 17763 23234 0,0,0 17764 23234 m. device66 17765 23234 g66: 85,0,r.34 17766 23234 17766 23234 0,0,0 17767 23234 m. device 67 17768 23234 g67: 85,0,r.34 17769 23234 17769 23234 0,0,0 17770 23234 m. device 68 17771 23234 g68: 85,0,r.34 17772 23234 17772 23234 0,0,0 17773 23234 m. device 69 17774 23234 g69: 85,0,r.34 17775 23234 17775 23234 0,0,0 17776 23234 m. device70 17777 23234 g70: 85,0,r.34 17778 23234 17778 23234 0,0,0 17779 23234 m. device71 17780 23234 g71: 85,0,r.34 17781 23234 17781 23234 0,0,0 17782 23234 m. device72 17783 23234 g72: 85,0,r.34 17784 23234 17784 23234 0,0,0 17785 23234 m. device73 17786 23234 g73: 85,0,r.34 17787 23234 17787 23234 0,0,0 17788 23234 m. device74 17789 23234 g74: 85,0,r.34 17790 23234 17790 23234 0,0,0 17791 23234 m. device75 17792 23234 g75: 85,0,r.34 17793 23234 17793 23234 0,0,0 17794 23234 m. device76 17795 23234 g76: 85,0,r.34 17796 23234 17796 23234 0,0,0 17797 23234 m. device 77 17798 23234 g77: 85,0,r.34 17799 23234 17799 23234 0,0,0 17800 23234 m. device 78 17801 23234 g78: 85,0,r.34 17802 23234 17802 23234 0,0,0 17803 23234 m. device 79 17804 23234 g79: 85,0,r.34 17805 23234 17805 23234 0,0,0 17806 23234 m. device80 17807 23234 g80: 85,0,r.34 17808 23234 17808 23234 0,0,0 17809 23234 m. device81 17810 23234 g81: 85,0,r.34 17811 23234 17811 23234 0,0,0 17812 23234 m. device82 17813 23234 g82: 85,0,r.34 17814 23234 17814 23234 0,0,0 17815 23234 m. device83 17816 23234 g83: 85,0,r.34 17817 23234 17817 23234 0,0,0 17818 23234 m. device84 17819 23234 g84: 85,0,r.34 17820 23234 17820 23234 0,0,0 17821 23234 m. device85 17822 23234 g85: 85,0,r.34 17823 23234 17823 23234 0,0,0 17824 23234 m. device86 17825 23234 g86: 85,0,r.34 17826 23234 17826 23234 0,0,0 17827 23234 m. device 87 17828 23234 g87: 85,0,r.34 17829 23234 17829 23234 0,0,0 17830 23234 m. device 88 17831 23234 g88: 85,0,r.34 17832 23234 17832 23234 0,0,0 17833 23234 m. device 89 17834 23234 g89: 85,0,r.34 17835 23234 17835 23234 0,0,0 17836 23234 m. device90 17837 23234 g90: 85,0,r.34 17838 23234 17838 23234 0,0,0 17839 23234 m. device91 17840 23234 g91: 85,0,r.34 17841 23234 17841 23234 0,0,0 17842 23234 m. device92 17843 23234 g92: 85,0,r.34 17844 23234 17844 23234 0,0,0 17845 23234 m. device93 17846 23234 g93: 85,0,r.34 17847 23234 17847 23234 0,0,0 17848 23234 m. device94 17849 23234 g94: 85,0,r.34 17850 23234 17850 23234 0,0,0 17851 23234 m. device95 17852 23234 g95: 85,0,r.34 17853 23234 17853 23234 0,0,0 17854 23234 m. device96 17855 23234 g96: 85,0,r.34 17856 23234 17856 23234 0,0,0 17857 23234 m. device 97 17858 23234 g97: 85,0,r.34 17859 23234 17859 23234 0,0,0 17860 23234 m. device 98 17861 23234 g98: 85,0,r.34 17862 23234 17862 23234 0,0,0 17863 23234 m. device 99 17864 23234 g99: 85,0,r.34 17865 23234 17865 23234 z. 17866 23234 17866 23234 n.m. 17866 23234 monitor peripheral process descriptions included 17867 23234 17867 23234 f20=k ; top 17868 23234 17868 23234 ; external interrupt table: 17869 23234 ; 17870 23234 b53: c2 ; integer interrupt etc: 17871 23236 c2 ; 17872 23238 c2 ; 17873 23240 ; the next entries pertain to various cpu- or system faults: 17874 23240 c3 ; limit violation (due to monitor bugs) 17875 23242 c4 ; bus error , during operand transfer 17876 23244 c5 ; bus error , during instruction fetch 17877 23246 c6 ; power failure 17878 23248 h24+a240 ; clock 17879 23250 ; the remaining entries are inserted via the monitor options: 17880 23250 t. 17880 23250* type 17881 23250 17881 23250 m. 17881 23250 interrupt table 17882 23250 g15+a240 17883 23252 g16+a240 17884 23254 g28+a240 17885 23256 g29+a240 17886 23258 n.m. 17886 23258 monitor interrupt table included 17887 23258 17887 23258 b54 = (:k - b53:) > 1 - 1; max interrupt number 17888 23258 17888 23258 ; controller description table: 17889 23258 ; 17890 23258 ; each entry consists (initially) of: 17891 23258 ; entry + a310 : (irrellevant) 17892 23258 ; entry + a311 : device descr + a230 17893 23258 ; entry + a312 : cpu-address (=a198) 17894 23258 ; entry + a313 : interrupt number 17895 23258 f16: ; start of controller table: 17896 23258 t. 17896 23258* type 17897 23258 17897 23258 m. 17897 23258 controller table 17898 23258 0,g15+a230,a198,8 17899 23266 0,g16+a230,a198,9 17900 23274 0,g28+a230,a198,10 17901 23282 0,g29+a230,a198,11 17902 23290 n.m. 17902 23290 monitor controller table included 17903 23290 f17: ; top of controller table 17904 23290 17904 23290 17904 23290 17904 23290 a114=a114+a88+2, a114=a114+(:a114 a. 1:) 17905 23290 a116=a116+a88+2, a116=a116+(:a116 a. 1:) 17906 23290 17906 23290 a127=(:f2-f1:)>1 ; number of peripheral processes 17907 23290 17907 23290 ; area processes: 17908 23290 f7=k, h7=f7-a349 17909 23290 ; internal processes: 17910 23290 f8=f7 + a1*a2, h8=f8+4 17911 23290 ; drum chains: 17912 23290 f11=f8 + a3*a4, h9=f11+a88+2 17913 23290 ; disc chains: 17914 23290 f12=f11 + a113*a114, h10=f12+a88+2 17915 23290 ; message buffers: 17916 23290 f9=f12 + a115*a116, f10=f9 + a5*a6 - 2 17917 23290 17917 23290 ; monitor entries used globally: 17918 23290 b29 = h8 ; first internal process 17919 23290 b35 = d5 ; remove 17920 23290 b36 = d6 ; link 17921 23290 b40 = d73 ; max base - (1,1) 17922 23290 b41 = d74 ; follow chain 17923 23290 b42 = d71 ; search name(name, entry, base) 17924 23290 b43 = d75 ; regretted message 17925 23290 b44 = d5 ; remove(elem) 17926 23290 b45 = d72 ; max base 17927 23290 17927 23290 b.i1 ; begin 17928 23290 w.i0: rl. w2 i1. ; make room: 17929 23292 jl x3+0 ; autoloader(chaintable end + 2); 17930 23294 i1: f10+2 ; after loading: 17931 23296 jl. i0. ; goto make room; 17932 23298 e. ; end 17933 23298 i. 17934 23298 h25=k - b127 + 2 17935 23298 e. ; end of process description segment 17936 23298 17936 23298 k = b29-4 + a3 * a4 + a5 * a6 + a113*a114 + a115*a116 17937 42536 ; comment: k = absolute top address of monitor. 17938 42536 \f 17938 42536 17938 42536 17938 42536 ; segment 5: initialize monitor 17939 42536 ; this segment initializes monitor table, process descriptions, 17940 42536 ; and buffers within the monitor as follows: 17941 42536 ; monitor table: 17942 42536 ; initialized as defined on page 6 17943 42536 ; area process descriptions: 17944 42536 ; description address is placed in name table 17945 42536 ; description is initialized to zero 17946 42536 ; kind is set to 4 17947 42536 ; internal process descriptions: 17948 42536 ; description address is placed in name table 17949 42536 ; description is initialized to zero 17950 42536 ; identification bit is set to 1<n 17951 42536 ; next and last event are set to next event 17952 42536 ; message and console buffers: 17953 42536 ; buffer is initialized to zero 17954 42536 ; buffer is linked to pool 17955 42536 ; after return to the autoloader, the segment is removed. 17956 42536 17956 42536 s.k=k, g30 ; begin 17957 42536 w.b127=k, g30, k=k-2 17958 42536 w.g1: rs. w3 g8. ; start: 17959 42538 17959 42538 ; get number of storage bytes 17960 42538 gg w1 b92 ; w1 := core size; 17961 42540 rs w1 b12 ; save core size in monitor table 17962 42542 17962 42542 ; initialize other parts of monitor table: 17963 42542 al. w3 g10. ; 17964 42544 g16: dl w2 x3+2 ; 17965 42546 al w3 x3+4 ; 17966 42548 rs w2 x1 ; 17967 42550 se w1 0 ; 17968 42552 jl. g16. ; 17969 42554 17969 42554 ; initialize base of controller table: 17970 42554 17970 42554 rl w1 b67 ; 17971 42556 rl w2 x1+a311 ; 17972 42558 rl w2 x2-a230+a235; w2:= device addr (first device descr); 17973 42560 ls w2 1 ; 17974 42562 ls w2 -1 ; 17975 42564 ws w1 4 ; 17976 42566 rs w1 b65 ; 17977 42568 17977 42568 rl w2 b4 ; name table: 17978 42570 g0: rl w0 (x2+a10) ; 17979 42572 sn w0 86 ; 17980 42574 jl. g7. ; 17981 42576 se w0 88 ; if kind(proc)=fparec,trm then 17982 42578 jl. g2. ; initiate first,top own area; 17983 42580 g7: rl w3 x2 ; 17984 42582 dl. w1 g13. ; 17985 42584 ws w0 6 ; 17986 42586 ws w1 6 ; 17987 42588 ds w1 x3+a221 ; 17988 42590 g2: al w2 x2+2 ; 17989 42592 se w2 (b5) ; 17990 42594 jl. g0. ; 17991 42596 17991 42596 al w0 0 ; 17992 42598 rl w2 (b5) ; 17993 42600 al w2 x2+a349 ; 17994 42602 g3: rs w0 x2 ; 17995 42604 al w2 x2+2 ; for addr:= name table(first area) 17996 42606 sh w2 (b8+6) ; step 2 until console pool end 17997 42608 jl. g3. ; do word(addr):= 0; 17998 42610 rl w2 b5 ; entry:= first area; 17999 42612 rl w3 x2+0 ; proc:= name table(entry); 18000 42614 al w0 4 ; area process: 18001 42616 g4: rs w3 x2+0 ; name table(entry):= proc; 18002 42618 rs w0 x3+0 ; kind(proc):= 4; 18003 42620 al w2 x2+2 ; entry:= entry + 2; 18004 42622 al w3 x3+a2 ; proc:= proc + area proc size; 18005 42624 se w2 (b6) ; if entry <> first internal 18006 42626 jl. g4. ; then goto area process; 18007 42628 rl. w0 g9. ; id bit:= 1 shift 23; 18008 42630 rl w3 x2+0 ; proc:= name table(entry); 18009 42632 ; internal process: 18010 42632 g5: rs w3 x2+0 ; name table(entry):= proc; 18011 42634 rs w0 x3+a14 ; identification(proc):= id bit; 18012 42636 al w1 x3+a15 ; next(event q(proc)):= 18013 42638 rs w1 x3+a15 ; last(event q(proc)):= 18014 42640 rs w1 x3+a15+2 ; event q(proc); 18015 42642 ls w0 -1 ; id bit:= id bit shift (-1); 18016 42644 al w2 x2+2 ; entry:= entry + 2; 18017 42646 al w3 x3+a4 ; proc:= proc + internal proc size; 18018 42648 se w2 (b7) ; if entry <> name table end 18019 42650 jl. g5. ; then goto internal process; 18020 42652 al w1 a46 ; claims rel addr:=first claim 18021 42654 al w0 0 ; 18022 42656 c. (:a113-1:) 18023 42656 rl w2 b22 ; entry:= first drum chain 18024 42656 rl w3 x2 ; chain:= nametable(entry) 18025 42656 g11:rs w3 x2 ; nametable(entry):=chain 18026 42656 rs w0 x3-a88+16 ; state(chain):= free 18027 42656 rs w1 x3-a88-2 ; claims rel addr(chain):=claims rel addr 18028 42656 al w2 x2+2 ; entry:=entry+2 18029 42656 am a88+2 ; 18030 42656 al w3 x3+a114-a88-2; chain:=chain+drumchain size 18031 42656 al w1 x1+a110*2+2 ; claims rel addr:=claims rel addr+max key+2 18032 42656 se w2 (b23) ; if entry<>first disc chain 18033 42656 jl. g11. ; then goto drum chain 18034 42656 z. 18035 42656 c. (:a115-1:) 18036 42656 rl w2 b23 ; entry:= first disc chain 18037 42658 rl w3 x2 ; 18038 42660 g12:rs w3 x2 ; 18039 42662 rs w0 x3-a88+16 ; 18040 42664 rs w1 x3-a88-2 ; 18041 42666 al w2 x2+2 ; 18042 42668 am a88+2 ; 18043 42670 al w3 x3+a116-a88-2;chain:=chain+discchain size 18044 42672 al w1 x1+a110*2+2 ; 18045 42674 se w2 (b24) ; if entry<>chain end 18046 42676 jl. g12. ; then goto disc chain 18047 42678 z. 18048 42678 al w1 b8 ; 18049 42680 rl w2 b8+4 ; 18050 42682 g6: jl w3 b36 ; for buf:= first buf(mess pool) 18051 42684 wa w2 b8+8 ; step buf size(mess pool) 18052 42686 sh w2 (b8+6) ; until last buf(mess pool) 18053 42688 jl. g6. ; do link (mess pool, buf); 18054 42690 al. w2 g1. ; 18055 42692 jl. (g8.) ; autoloader(start); 18056 42694 18056 42694 g8: 0 18057 42696 g9: 1<23 18058 42698 f19 ; 18059 42700 g13: f20 ; 18060 42702 18060 42702 ; monitor table initialization: 18061 42702 ; 18062 42702 ; address contents 18063 42702 18063 42702 g10: 18064 42702 b0 , b53 - b16 ; 18065 42706 b2 , f5+a16 ; 18066 42710 b2+2 , f5+a16 ; 18067 42714 b3 , f0 ; 18068 42718 b4 , f1 ; 18069 42722 b5 , f2 ; 18070 42726 b6 , f3 ; 18071 42730 b7 , f4 ; 18072 42734 b8+4 , f9 ; 18073 42738 b8+6 , f10 ; 18074 42742 b21 , f5 ; 18075 42746 b22 , f13 ; 18076 42750 b23 , f14 ; 18077 42754 b24 , f15 ; 18078 42758 b30 , f18 18079 42762 b67 , f16 ; 18080 42766 b68 , f17 ; 18081 42770 b72 , b53 ; 18082 42774 b73 , b54 ; 18083 42778 b101 , b89 ; 18084 42782 b102 , a66 ; 18085 42786 18085 42786 ; insert in monitor table copies: 18086 42786 b128+0 , f0 ; 18087 42790 b128+2 , f1 ; 18088 42794 b128+4 , f2 ; 18089 42798 b128+6 , f3 ; 18090 42802 b128+8 , f4 ; 18091 42806 b128+10, f9 ; 18092 42810 b128+12, f10 ; 18093 42814 b128+14, f13 ; 18094 42818 b128+16, f14 ; 18095 42822 b128+18, f15 ; 18096 42826 b128+22, b86 ; 18097 42830 18097 42830 0 ; end of table 18098 42832 18098 42832 jl. g1. ; after loading: goto start 18099 42834 18099 42834 g30=k-b127 + 2 18100 42834 k=g1 18101 42536 ;comment: k = absolute first address of initialize monitor 18102 42536 i. 18103 42536 e. ; end of initialize monitor segment 18104 42536 18104 42536 e. ; end of monitor block with c, d, e,and f names 18105 42536 \f 18105 42536 18105 42536 m. 18105 42536 monprocfnc1 - monitor process functions, part 1 18106 42536 18106 42536 b.i30 w. 18107 42536 i0=82 04 23, i1=12 00 00 18108 42536 18108 42536 ; if newtime (i0,i1) > oldtime (a133,a134) then oldtime:=newtime; 18109 42536 c.i0-a133 18110 42536 c.i0-a133-1, a133=i0, a134=i1, z. 18111 42536 c.i1-a134-1, a134=i1, z. 18112 42536 z. 18113 42536 18113 42536 i10=i0, i20=i1 18114 42536 18114 42536 i15=i10/100000 , i10=i10-i15*100000 , i25=i20/100000 , i20=i20-i25*100000 18115 42536 i14=i10/10000 , i10=i10-i14*10000 , i24=i20/10000 , i20=i20-i24*10000 18116 42536 i13=i10/1000 , i10=i10-i13*1000 , i23=i20/1000 , i20=i20-i23*1000 18117 42536 i12=i10/100 , i10=i10-i12*100 , i22=i20/100 , i20=i20-i22*100 18118 42536 i11=i10/10 , i10=i10-i11*10 , i21=i20/10 , i20=i20-i21*10 18119 42536 18119 42536 i2: <: date :> 18120 42560 (:i15+48:)<16+(:i14+48:)<8+46 18121 42562 (:i13+48:)<16+(:i12+48:)<8+46 18122 42564 (:i11+48:)<16+(:i10+48:)<8+32 18123 42566 18123 42566 (:i25+48:)<16+(:i24+48:)<8+46 18124 42568 (:i23+48:)<16+(:i22+48:)<8+46 18125 42570 (:i21+48:)<16+(:i20+48:)<8+ 0 18126 42572 18126 42572 i3: al. w0 i2. ; write date: 18127 42574 rs w0 x2+0 ; first free:=start(text); 18128 42576 al w2 0 ; 18129 42578 jl x3 ; return to slang(status ok); 18130 42580 18130 42580 jl. i3. ; 18131 42582 e. 18132 42582 j. 18132 42536 date 82.04.23 12.00.00 18133 42536 18133 42536 ; rc date 18134 42536 18134 42536 ; rc 4000 systems tape, segment 6: process functions. 18135 42536 ; leif svalgaard / jørn jensen 18136 42536 ; catalog administration; creation, removal, and 18137 42536 ; start and stop of processes. 18138 42536 18138 42536 ; the code includes certain test options selected by bits in the identifier 18139 42536 ; a92 as follows: 18140 42536 ; test call included: a92 = a92 o. 1<19 18141 42536 ; monitor test output: a92 = a92 o. 1<20 18142 42536 ; print w, type w: a92 = a92 o. 1<21 18143 42536 18143 42536 18143 42536 s. c10, d50, e99, f100, i70, j21, m280, n50, p65, r7, t40, v40 18144 42536 18144 42536 b60: ; start of proc func 18145 42536 w.b127=k, j21, k=k-2 18146 42536 18146 42536 ; use of slang names: 18147 42536 ; a: monitor constants, declared and defined before proc func 18148 42536 ; b: monitor absolute entry addresses, - - - - 18149 42536 ; c: global full word constants 18150 42536 ; d: global variables, start addresses for records 18151 42536 ; e: procedures, mostly called with w3 as return register 18152 42536 ; f: constant names, relative addresses in records 18153 42536 ; g: local labels in procedures and actions 18154 42536 ; i: process functions (actions) 18155 42536 ; j: global points in central administration, error exits 18156 42536 ; 18157 42536 ; note: in the comments to the code the notation x.b denotes a reference to the 18158 42536 ; variable x in the record b. 18159 42536 18159 42536 ; definition of catalog parameters: 18160 42536 f0 = a88 ; size of one catalog entry: 34 bytes 18161 42536 f9 = 512 - 2 ; catalog buffer size - 2 : 510 bytes 18162 42536 f10 = f9/f0 ; number of entries per segment: 15 18163 42536 18163 42536 ; record sender. 18164 42536 ; the absolute address of the description of the calling process is stored 18165 42536 ; in d2. parameters to and from the sender are found in the register dump 18166 42536 ; as follows: 18167 42536 f20 = a31 ; save w3: name address 18168 42536 f21 = a29 ; save w1: tail address 18169 42536 f22 = a29 ; or: new name address 18170 42536 f23 = a29 ; or: catalog key 18171 42536 f24 = a29 ; or: general parameter pointer 18172 42536 f25 = a28 ; save w0: result 18173 42536 f26 = a40 ; save wait address 18174 42536 18174 42536 ; definition of proc func communications parameters 18175 42536 18175 42536 f14 = 3 ; operation read 18176 42536 f15 = 5 ; operation write 18177 42536 f16 = 48 ; minimum value of digit in identifier 18178 42536 f17 = 57 ; maximum - - - - - 18179 42536 f18 = 97 ; minimum - - letter - - 18180 42536 f19 = 125 ; maximum - - - - - 18181 42536 f37 = 0 ; kind: internal process 18182 42536 f38 = 4 ; kind: area process 18183 42536 18183 42536 ; definition of bits and values of process states 18184 42536 18184 42536 f40 = 1<2 ; repeat bit, in proc state 18185 42536 f41 = 1<3 ; no stop bit, in proc state 18186 42536 f42 = 1<4 ; parent bit, in proc state 18187 42536 f43 = 1<5 ; stopped bit, in proc state 18188 42536 f44 = 1<6 ; out of q bit,in proc state 18189 42536 f45 = 1<7 ; waiting bit, in proc state 18190 42536 18190 42536 ; process state values 18191 42536 18191 42536 f46 = a95 ; running 18192 42536 f47 = a99 ; waiting start by parent 18193 42536 f48 = a97 ; waiting stop by parent 18194 42536 f49 = a100 ; waiting start by ancestor 18195 42536 f50 = a98 ; waiting stop by ancestor 18196 42536 18196 42536 ; note: the above a-names are defined before proc func loading. 18197 42536 ; running: out of q, no stop 18198 42536 ; waiting start by parent stopped, parent, no stop 18199 42536 ; waiting stop by parent stopped, parent 18200 42536 ; waiting start by ancestor stopped, no stop 18201 42536 ; waiting stop by ancestor stopped 18202 42536 ; waiting events repeat 18203 42536 ; waiting for proc func repeat, out of q 18204 42536 ; 18205 42536 18205 42536 ; definition of function keys 18206 42536 18206 42536 f71 = 1<10 ; bit 1 : aux catalog handling 18207 42536 f72 = 1<9 ; bit 2 : main catalog handling 18208 42536 f74 = 1<7 ; bit 4 : create peripheral process 18209 42536 f75 = 1<6 ; bit 5 : remove peripheral process 18210 42536 f76 = 1<5 ; bit 6 : aux entry handling 18211 42536 f77 = 1<4 ; bit 7 : set clock 18212 42536 18212 42536 18212 42536 ; definition of chain states 18213 42536 18213 42536 t0 = 1<0 ; idle 18214 42536 t1 = 1<1 ; after prepare 18215 42536 t2 = 1<2 ; during insert 18216 42536 t3 = 1<3 ; ready 18217 42536 t4 = 1<4 ; during delete 18218 42536 t5 = 1<5 ; during check 18219 42536 t6 = 1<6 ; during aux entry manipulation 18220 42536 18220 42536 t20 = t0 ; allowed for prepare bs 18221 42536 t21 = t1+t2 ; allowed for insert entry 18222 42536 ; insert bs 18223 42536 ; connect main catalog 18224 42536 t22 = t3 ; allowed for normal use 18225 42536 t23 = t1+t2+t3+t4+t5+t6; allowed for delete bs 18226 42536 t24 = t4 ; allowed for delete entries 18227 42536 t26 = t1+t5 ; allowed for check aux catalog 18228 42536 t28 = t1+t2+t6 ; allowed for create aux entry 18229 42536 t29 = t1+t2+t3+t4+t5+t6; allowed for set bs-claims 18230 42536 t30 = t1+t2+t3+t6 ; allowed for create area process 18231 42536 18231 42536 18231 42536 ; format of catalog entry 18232 42536 ; the formats of entries in main catalog and auxiliary catalogs are the 18233 42536 ; same, except for a field on 4 words that 18234 42536 ; - in main catalog contains document name, and 18235 42536 ; - in aux catalogs contains 18236 42536 ; word0: entry last change (of entry), shortclock 18237 42536 ; word1: write access counter 18238 42536 ; word2: read access counter 18239 42536 ; word3: dummy 18240 42536 18240 42536 f4 = 0 ; byte ; <first slice> 18241 42536 f3 = 1 ; byte ; <namekey> * 8 + <perm key> 18242 42536 f1 = 2 ; word ; <lower base of entry> 18243 42536 f2 = 4 ; word ; <upper base of entry> 18244 42536 f5 = 6 ; name ; <entry name> 18245 42536 f7 = 14 ; word ; <size of entry> 18246 42536 f11 = 16 ; name ; main: <document name> 18247 42536 f11 = f11 ; word ; aux: <last change> 18248 42536 f12 = f11+2 ; double ; <write access counter>,<read access counter> 18249 42536 f13 = f12+4 ; word ; <last used> 18250 42536 18250 42536 f0 = a88 ; size of catalog entry 18251 42536 f6 = 14 ; start of tail 18252 42536 f8 = f0-f6 ; size of tail 18253 42536 f51 = -8 ; mask for extracting all but perm-key 18254 42536 18254 42536 18254 42536 ; format of chainhead 18255 42536 18255 42536 f60 = -2 - f0 ; <claims rel address in internal process> 18256 42536 f54 = f4 - f0 ; <first slice of aux catalog> 18257 42536 f53 = f3 - f0 ; <chain kind> * 8 + <perm key> 18258 42536 f55 = f5 - f0 ; <name of aux catalog> 18259 42536 f56 = f6 - f0 ; (start of tail) 18260 42536 f57 = f7 - f0 ; <size of aux catalog> 18261 42536 f61 = f11- f0 ; <document name> 18262 42536 f62 = f56+10 ; word ; <name table address of disc process> 18263 42536 f64 = f56+12 ; word ; <slice length> 18264 42536 f66 = f56+14 ; byte ; <last slice in chaintable> 18265 42536 f67 = f56+15 ; byte ; <first slice of chaintable-chain> 18266 42536 f68 = f56+16 ; byte ; <chain state> 18267 42536 f69 = f56+17 ; byte ; <cur key> (used as segment number in certain clean-ups) 18268 42536 f70 = f56+18 ; word ; <name table address of aux catalog area process> 18269 42536 18269 42536 ; each chaintable has a heading as the above given, which has the same 18270 42536 ; basic format as a normal catalog entry. 18271 42536 ; it describes the aux catalog on the device. 18272 42536 ; after the heading follows the chain-area, consisting of one byte for 18273 42536 ; each slice. 18274 42536 18274 42536 18274 42536 18274 42536 ; record for main catalog pseudo chainhead 18275 42536 ; (format as a normal chainhead) 18276 42536 d9 = k - f54 ; base of pseudo chainhead: 18277 42536 0, r. f0>1 ; 18278 42570 18278 42570 18278 42570 18278 42570 ; description of current catalog 18279 42570 18279 42570 c0: 0 ; size of current catalog 18280 42572 d7: 0, r.4 ; name of current catalog 18281 42580 0 ; (name table address of current catalog area process) 18282 42582 18282 42582 18282 42582 18282 42582 ; description of catalog message 18283 42582 18283 42582 d8: ; cat message: 18284 42582 f30 = k - d8, f14<12 ; operation (initially read) 18285 42584 f32 = k - d8, d0 ; first address of catalog buffer 18286 42586 f34 = k - d8, d18 ; last address of catalog buffer 18287 42588 f36 = k - d8, -1 ; current cat segment (initially not existing) 18288 42590 18288 42590 18288 42590 ; common work variables: 18289 42590 0 ;-2 work 18290 42592 d12: 0 ; return 18291 42594 18291 42594 18291 42594 18291 42594 ; procedure set auxcat 18292 42594 ; call: jl. w3 e0. 18293 42594 ; 18294 42594 ; procedure set maincat 18295 42594 ; call: jl. w3 e1. 18296 42594 ; 18297 42594 ; the use of the current catalog is terminated, and the 18298 42594 ; new catalog is selected as curcat 18299 42594 ; 18300 42594 ; error return: result 2, in case of io-errors 18301 42594 ; return: all regs undef 18302 42594 18302 42594 b. g10, h10 w. 18303 42594 18303 42594 e0: ; set auxcat: 18304 42594 rl. w1 (h2.) ; catchain := curdoc; 18305 42596 jl. g1. ; else 18306 42598 e1: ; set maincat: 18307 42598 al. w1 d9. ; catchain := pseudo chain for main catalog; 18308 42600 18308 42600 g1: sn. w1 (c2.) ; if catchain = curcat then 18309 42602 jl x3 ; return; 18310 42604 18310 42604 rs. w3 h0. ; save(return); 18311 42606 18311 42606 ; notice: be very cautious not to change curcat until all transfers are 18312 42606 ; terminated 18313 42606 18313 42606 rs. w1 h1. ; save (catchain); 18314 42608 18314 42608 jl. w3 e7. ; terminate update; 18315 42610 ; (if io-errors the curcat is not changed yet) 18316 42610 18316 42610 rl. w1 h1. ; w1 := new cur cat; 18317 42612 rl w0 x1+f57 ; move: catsize 18318 42614 rs. w0 c0. ; 18319 42616 al w0 -1 ; dummy segment number 18320 42618 rs. w0 d8.+f36; (i.e. simulate irrell buffer contents) 18321 42620 rl w0 x1+f70 ; name table address of catalog area process 18322 42622 rx. w0 d7.+8 ; 18323 42624 18323 42624 al w2 x1+f55 ; catalog name; 18324 42626 18324 42626 rx. w1 c2. ; curcat := new cur cat; 18325 42628 rs w0 x1+f70 ; save old name table address in old curcat; 18326 42630 18326 42630 al. w1 d7. ; 18327 42632 rl. w3 h0. ; 18328 42634 jl. e32. ; return; 18329 42636 18329 42636 c2: d9 ; curcat chainhead address (initially: pseudochainhead) 18330 42638 18330 42638 h0: 0 ; return 18331 42640 h1: 0 ; new curcat 18332 42642 h2: d4 18333 42644 18333 42644 e. ; 18334 42644 18334 42644 18334 42644 18334 42644 ; procedure dump chaintable 18335 42644 ; writes the chaintable of current document back on the device 18336 42644 ; 18337 42644 ; call: jl. w3 e2. 18338 42644 ; error return: result 2, in case of io-errors 18339 42644 ; return: all regs undef 18340 42644 18340 42644 b. h10 w. 18341 42644 18341 42644 e2: ; dump chain table: 18342 42644 rs. w3 d12. ; save(return); 18343 42646 rl. w3 d4. ; w3 := curdoc; 18344 42648 al w0 x3-f0 ; first addr := start of head.curdoc; 18345 42650 bz w1 x3+f66 ; 18346 42652 wa w1 6 ; last addr := start of chain.curdoc 18347 42654 al w1 x1+511 ; + last slice.curdoc + 511; (i.e. round up) 18348 42656 ds. w1 h2. ; 18349 42658 bz w1 x3+f67 ; segment number := 18350 42660 wm w1 x3+f64 ; first chaintable slice.curdoc 18351 42662 rs. w1 h3. ; * slicelength.curdoc; 18352 42664 18352 42664 al. w1 h0. ; 18353 42666 al w3 x3+f61 ; send message(document, output message); 18354 42668 jd 1<11+16; 18355 42670 al. w1 d16. ; wait answer; 18356 42672 jd 1<11+18; 18357 42674 18357 42674 rl w1 x1 ; 18358 42676 sn w0 1 ; if result <> ok 18359 42678 se w1 0 ; or status <> 0 then 18360 42680 jl. j2. ; goto result 2; 18361 42682 18361 42682 jl. (d12.) ; return; 18362 42684 18362 42684 h0: f15 < 12 ; output message: 18363 42686 0 ; first address 18364 42688 h2: 0 ; last address 18365 42690 h3: 0 ; segment number 18366 42692 18366 42692 e. ; 18367 42692 18367 42692 18367 42692 18367 42692 ; procedure compute namekey 18368 42692 ; sets namekey.work := namekey function(name.work) 18369 42692 ; 18370 42692 ; the namekey is a numer ranging from 0 to the number of segments (less one) 18371 42692 ; in the catalog. the namekey is computed from the name following the 18372 42692 ; algorithm below, and is used to speed-up the search for the name in 18373 42692 ; the catalog. 18374 42692 ; when an entry is created it is placed in the first free entry in the 18375 42692 ; catalog on the segment <namekey>, or the following segments. 18376 42692 ; the search for an entry then starts from the segment <namekey> and 18377 42692 ; towards higher segment numbers. 18378 42692 ; (the successor to the last segment is segment zero) 18379 42692 ; 18380 42692 ; call: jl. w3 e3. 18381 42692 ; return: w2 = namekey.work < 3 + key.work 18382 42692 ; other regs undef 18383 42692 18383 42692 e3: ; compute namekey: 18384 42692 dl. w2 v13. ; double := name(0), name(2) 18385 42694 aa. w2 v14. ; + name(4), name(6); 18386 42696 wa w2 2 ; word := double(0) + double(2); 18387 42698 ba w2 4 ; word := word + word // 4096; 18388 42700 al w1 0 ; 18389 42702 wd. w2 c0. ; namekey := word mod catsize; 18390 42704 ls w1 3 ; 18391 42706 al w2 -f51-1 ; 18392 42708 la. w2 v3. ; namekey.work := namekey; 18393 42710 wa w2 2 ; 18394 42712 hs. w2 v3. ; 18395 42714 jl x3 ; return; 18396 42716 18396 42716 18396 42716 18396 42716 ; the following complex of io-procedures all have a common 18397 42716 ; return information: 18398 42716 ; return: w0 = undef 18399 42716 ; w1 = segment number 18400 42716 ; w2 = absolute address of start of buffer 18401 42716 ; w3 = undef 18402 42716 ; cur cat segment defined 18403 42716 ; error return: result 2, in case of io-errors 18404 42716 18404 42716 ; procedure get key segment 18405 42716 ; ensures that the segment given by namekey.work is present 18406 42716 ; in the buffer 18407 42716 ; 18408 42716 ; call: jl. w3 e4. 18409 42716 ; 18410 42716 ; 18411 42716 ; procedure get cat segment 18412 42716 ; ensures that the segment given as parameter is present 18413 42716 ; 18414 42716 ; call: al w2 <segment number> 18415 42716 ; jl. w3 e5. 18416 42716 ; 18417 42716 ; 18418 42716 ; procedure get next segment 18419 42716 ; gets the next (cyclically numberred) segment into the buffer 18420 42716 ; 18421 42716 ; call: jl. w3 e6. 18422 42716 ; 18423 42716 ; 18424 42716 ; procedure terminate update 18425 42716 ; the current catalog segment is written back, in case of changes 18426 42716 ; 18427 42716 ; call: jl. w3 e7. 18428 42716 18428 42716 b. g10 w. 18429 42716 18429 42716 e4: ; get key segment: 18430 42716 bz. w2 v3. ; 18431 42718 ls w2 -3 ; segment := namekey.work; 18432 42720 e5: ; get cat segment: 18433 42720 ; (w2 = segment) 18434 42720 se. w2 (d8.+f36); if segment <> current segment then 18435 42722 jl. g1. ; goto get segment; 18436 42724 18436 42724 g0: ; exit: 18437 42724 al w1 x2 ; w1 := segment; 18438 42726 rl. w2 d8.+f32; w2 := abs first of buffer; 18439 42728 jl x3 ; return; 18440 42730 18440 42730 e6: ; get next segment: 18441 42730 am 1-0 ; incr := 1; 18442 42732 e7: ; terminate update: 18443 42732 al w2 0 ; incr := 0; 18444 42734 wa. w2 d8.+f36; segment := current segment + incr; 18445 42736 18445 42736 sl. w2 (c0.) ; if segment outside catalog then 18446 42738 al w2 0 ; segment := 0; 18447 42740 18447 42740 g1: ; get segment: 18448 42740 ; (w2 = segment, w3 = return) 18449 42740 ds. w3 d12. ; save(segment, return); 18450 42742 bz. w0 d8.+f30; 18451 42744 se w0 f15 ; if catoperation <> output then 18452 42746 jl. g4. ; goto test input nescessary; 18453 42748 g2: ; after output: 18454 42748 al. w3 d7. ; w3 := catalog name address; 18455 42750 18455 42750 bz. w0 d8.+f30; if catoperation = write then 18456 42752 sn w0 f15 ; 18457 42754 jd 1<11+8 ; reserve process(catalog); (i.e. after update) 18458 42756 18458 42756 al. w1 d8. ; 18459 42758 jd 1<11+16; send message(catalog, catmessage); 18460 42760 bz. w0 d8.+f30; 18461 42762 sn w0 f15 ; if after update then 18462 42764 jd 1<11+10; release process(catalog); 18463 42766 ; (i.e. don't exclude other processes too long) 18464 42766 18464 42766 al w1 f14 ; catoperation := read; 18465 42768 hs. w1 d8.+f30; (only needed after update, but anyway...) 18466 42770 18466 42770 al. w1 d16. ; 18467 42772 jd 1<11+18; wait answer; 18468 42774 18468 42774 al w2 -1 ; (prepare for io-errors) 18469 42776 sn w0 1 ; if result <> ok 18470 42778 sz w2 (x1) ; or status <> 0 then 18471 42780 jl. g5. ; goto catalog io-error; 18472 42782 18472 42782 ; a transfer has now been completed. 18473 42782 ; if after update the transfer was an output, terminating the earlier 18474 42782 ; segment. in this case the new segment must be brougth into the buffer 18475 42782 18475 42782 dl. w3 d12. ; restore(segment, return); 18476 42784 18476 42784 g4: ; test input nescessary: 18477 42784 rx. w2 d8.+f36; current segment := segment; 18478 42786 se. w2 (d8.+f36); if current segment <> segment then 18479 42788 jl. g2. ; goto after write; 18480 42790 18480 42790 jl. g0. ; goto exit; 18481 42792 18481 42792 g5: ; catalog io-error: 18482 42792 rs. w2 d8.+f36; current segment := -1; 18483 42794 ; (i.e. undefined contents of catalog buffer) 18484 42794 jl. j2. ; goto result 2; 18485 42796 18485 42796 e. ; 18486 42796 18486 42796 18486 42796 18486 42796 ; the following set of procedures are intended for updating 18487 42796 ; and utilizing the information given in each catalog segment: 18488 42796 ; each segment contains a number, <entry count>, stating the 18489 42796 ; number of entries with a namekey corresponding to the 18490 42796 ; segment-number 18491 42796 ; notice: 18492 42796 ; ********************************************************* 18493 42796 ; * * 18494 42796 ; * in case of break-down during a multi-segment updating * 18495 42796 ; * the entry count may be one (or more) too large, * 18496 42796 ; * but never too small * 18497 42796 ; * * 18498 42796 ; * i.e. it is actually a maximum number of entries * 18499 42796 ; * * 18500 42796 ; * it will be reset at the first catalog search with * 18501 42796 ; * that particular namekey * 18502 42796 ; * * 18503 42796 ; ********************************************************* 18504 42796 18504 42796 b. g30, h10 w. 18505 42796 18505 42796 ; procedure prepare update and change entry count 18506 42796 ; call: al w0 <change of entry count> 18507 42796 ; al w2 <start of catalog buffer> 18508 42796 ; jl. w3 e8. 18509 42796 ; return: all regs undef 18510 42796 ; 18511 42796 ; the corresponding entry count is updated 18512 42796 ; and the segment is flagged for being written back 18513 42796 18513 42796 e8: ; change entry count and prepare update: 18514 42796 wa w0 x2+f9 ; entry count.buffer := 18515 42798 rs w0 x2+f9 ; entry count.buffer + change; 18516 42800 18516 42800 ; procedure prepare update 18517 42800 ; call: jl. w3 e9. 18518 42800 ; return: all regs undef 18519 42800 ; 18520 42800 ; the current catalog segment is flagged for being written back 18521 42800 ; at next catalog transfer 18522 42800 18522 42800 e9: ; prepare update: 18523 42800 al w0 f15 ; catoperation := write; 18524 42802 hs. w0 d8.+f30; 18525 42804 jl x3 ; return; 18526 42806 18526 42806 18526 42806 ; procedure search free entry 18527 42806 ; a new entry is to be created. the entry is given in work. 18528 42806 ; entry count(namekey.work) is increased, and a free entry is searched 18529 42806 ; for. 18530 42806 ; if no room, then entry count is decreased again, and error return 18531 42806 ; 18532 42806 ; 18533 42806 ; call: jl. w3 e10. 18534 42806 ; jl. no room 18535 42806 ; jl. ok 18536 42806 ; error return: result 2, in case of io-error 18537 42806 ; return: cur entry (and segment defined) 18538 42806 18538 42806 e10: ; search free entry: 18539 42806 rs. w3 h1. ; save(return); 18540 42808 jl. w3 e4. ; get key segment; 18541 42810 rs. w1 h0. ; save(segment number); 18542 42812 al w0 1 ; 18543 42814 jl. w3 e8. ; increase(entry count) and prepare update; 18544 42816 18544 42816 g1: ; next segment: 18545 42816 al w0 -1 ; w0 := free pattern; 18546 42818 al w3 x2+f9 ; w3 := top of last entry; 18547 42820 g2: ; next entry: 18548 42820 ; (w0 = free pattern, w2 = entry, w3 = top) 18549 42820 sn w0 (x2) ; if first word of entry <> free pattern then 18550 42822 jl. g5. ; begin 18551 42824 al w2 x2+f0 ; entry := entry + entrysize; 18552 42826 se w2 x3 ; if more entries on same segment then 18553 42828 jl. g2. ; goto next entry; 18554 42830 18554 42830 jl. w3 e6. ; get next segment; 18555 42832 se. w1 (h0.) ; if cur segment <> key segment then 18556 42834 jl. g1. ; goto next segment; 18557 42836 18557 42836 jl. g10. ; goto decrease entry count; 18558 42838 18558 42838 g5: ; end; 18559 42838 ds. w2 d3. ; save(cur entry segment, cur entry); 18560 42840 am. (h1.) ; 18561 42842 jl +2 ; goto ok-return; 18562 42844 18562 42844 18562 42844 18562 42844 ; procedure get cur entry segment 18563 42844 ; ensures that the catalog buffer contains the appropriate segment 18564 42844 ; and that cur entry address is relevant in this buffer 18565 42844 ; 18566 42844 ; call: jl. w3 e11. 18567 42844 ; error return: result 2, in case of io-error 18568 42844 ; return: cur entry segment is in catbuffer 18569 42844 ; registers as get catalog segment 18570 42844 18570 42844 e11: ; get cur entry segment: 18571 42844 rl. w2 d29. ; segment := cur entry segment; 18572 42846 jl. e5. ; goto get catalog segment; 18573 42848 18573 42848 18573 42848 18573 42848 ; procedure set cur entry 18574 42848 ; moves the entry in work to the catalog segment, given by cur entry 18575 42848 ; 18576 42848 ; call: jl. w3 e12. 18577 42848 ; error return: result 2, in case of io-error 18578 42848 ; return: all regs undef 18579 42848 18579 42848 e12: ; set cur entry: 18580 42848 rs. w3 h1. ; save(return); 18581 42850 jl. w3 e11. ; get cur entry segment; 18582 42852 jl. w3 e9. ; prepare update; 18583 42854 18583 42854 rl. w1 d3. ; w1 := cur entry; 18584 42856 al. w2 d1. ; w2 := work; 18585 42858 jl. w3 e33. ; move work to cur entry; 18586 42860 18586 42860 jl. (h1.) ; 18587 42862 18587 42862 18587 42862 18587 42862 ; procedure delete cur entry 18588 42862 ; remove the entry given by cur entry, by setting the first word 18589 42862 ; of the entry to -1 18590 42862 ; entry count(namekey.work) is decreased 18591 42862 ; 18592 42862 ; call: jl. w3 e13. 18593 42862 ; error return: result 2, in case of io-error 18594 42862 ; return: all regs undef 18595 42862 18595 42862 e13: ; delete cur entry: 18596 42862 rs. w3 h1. ; save(return); 18597 42864 jl. w3 e11. ; get cur entry segment; 18598 42866 18598 42866 al w0 -1 ; 18599 42868 rs. w0 (d3.) ; first word(cur entry) := -1 18600 42870 jl. w3 e9. ; prepare update; 18601 42872 ; (notice: if the entry is not on the key segment 18602 42872 ; two segments must be updated) 18603 42872 jl. w3 e4. ; get key segment; 18604 42874 18604 42874 g10: ; decrease entry count: 18605 42874 al w0 -1 ; 18606 42876 g15: ; update and return: 18607 42876 jl. w3 e8. ; change entry count and prepare update; 18608 42878 jl. (h1.) ; return; 18609 42880 18609 42880 18609 42880 18609 42880 ; procedure for all key entries do 18610 42880 ; 18611 42880 ; delivers all entries, one at a time, with the namekey given 18612 42880 ; 18613 42880 ; call: al w2 <key> 18614 42880 ; jl. w3 e14. 18615 42880 ; jl. no more 18616 42880 ; (maybe save w2) 18617 42880 ; <action for found entry> 18618 42880 ; (restore w2, if destroyed) 18619 42880 ; jl x3 18620 42880 ; 18621 42880 ; error return: result 2, in case of io-errors 18622 42880 ; 18623 42880 ; return: link+0: no more entries (all regs undef) 18624 42880 ; link+2: w0w1 = undef, w2 = entry, w3 = continue search 18625 42880 ; (when continuing w2 must remain unchanged) 18626 42880 18626 42880 e14: ; for all key entries do: 18627 42880 ds. w3 h1. ; save(key, return); 18628 42882 jl. w3 e5. ; get cat segment; 18629 42884 al w3 x2+f9 ; w3 := top of last entry; 18630 42886 rs. w3 h3. ; 18631 42888 18631 42888 rl w3 x2+f9 ; remaining := entry count.key segment; 18632 42890 al w2 x2-f0 ; (decrease(entry) ... code trick) 18633 42892 18633 42892 g21: ; test remaining: 18634 42892 sn w3 0 ; if remaining = 0 then 18635 42894 jl. (h1.) ; return; 18636 42896 rs. w3 h2. ; 18637 42898 18637 42898 g22: ; next entry: 18638 42898 al w2 x2+f0 ; increase(entry); 18639 42900 sn. w2 (h3.) ; if out of buffer then 18640 42902 jl. g24. ; goto next segment; 18641 42904 18641 42904 g23: ; test entry: 18642 42904 rl w3 x2 ; 18643 42906 se w3 -1 ; if entry exists then 18644 42908 bz w3 x2+f3 ; key := key.entry; 18645 42910 as w3 -3 ; (otherwise key = not possible) 18646 42912 se. w3 (h0.) ; if key <> saved key then 18647 42914 jl. g22. ; goto next entry; 18648 42916 18648 42916 rl. w3 h1. ; 18649 42918 jl w3 x3+2 ; call(found action); (w2 = entry) 18650 42920 18650 42920 rl. w3 h2. ; 18651 42922 al w3 x3-1 ; decrease(remaining entries); 18652 42924 jl. g21. ; goto test remaining; 18653 42926 18653 42926 g24: ; next segment: 18654 42926 jl. w3 e6. ; get next segment; 18655 42928 18655 42928 al w3 x2+f9 ; compute top address of last entry; 18656 42930 rs. w3 h3. ; 18657 42932 18657 42932 se. w1 (h0.) ; if current segment <> key segment then 18658 42934 jl. g23. ; goto test entry; 18659 42936 18659 42936 ac. w0 (h2.) ; decrease entry count by remaining entries 18660 42938 jl. g15. ; and return; 18661 42940 18661 42940 h0: 0 ; saved key 18662 42942 h1: 0 ; saved return 18663 42944 h2: 0 ; remaining entries 18664 42946 h3: 0 ; top address of last entry on segment 18665 42948 18665 42948 e. ; 18666 42948 18666 42948 18666 42948 18666 42948 ; procedure compute document address 18667 42948 ; 18668 42948 ; selects either the maincat document or the document 18669 42948 ; specified in first slice.work 18670 42948 ; 18671 42948 ; call: jl. w3 e15. 18672 42948 ; return: w2 = doc address, other regs undef 18673 42948 18673 42948 e15: ; compute document address for non-area entries: 18674 42948 rl w2 b25 ; (prepare for maincat-entry) 18675 42950 bz. w1 v4. ; if first slice.work = 0 then 18676 42952 sn w1 0 ; w2 := maincat document 18677 42954 jl x3 ; and return; 18678 42956 18678 42956 am (b22) ; use the last 11 bits of first slice 18679 42958 rl w2 x1-2048 ; to select the document; 18680 42960 jl x3 ; return; 18681 42962 18681 42962 ; procedure first proc (proc addr,new state); 18682 42962 ; finds the process given by name.work and checks that it is a child 18683 42962 ; of the sender. 18684 42962 ; initializes end chain and children bits and returns disabled 18685 42962 ; with w3 = proc addr and new state = wait stop by parent. 18686 42962 ; call: jl. w3 e17. 18687 42962 ; return: disabled with 18688 42962 ; w1 = sender 18689 42962 ; w2 = new state 18690 42962 ; w3 = proc addr 18691 42962 ; w0 changed 18692 42962 ; error: not child: error 3; 18693 42962 18693 42962 e17: c.(:a92>19a.1:)-1 ; if test call included then 18694 42962 ds w3 b34 ; test output (e17); 18695 42962 jd. w3 e29. ; 18696 42962 z. rs. w3 d12. ; first proc: save return; 18697 42964 jl. w3 e47. ; search best process in nametable; 18698 42966 b3 ; 18699 42968 b7 ; 18700 42970 jl. e26. ;+6: not found: goto test found; 18701 42972 al w3 x2 ; proc := proc found; 18702 42974 rl w0 x3+a10 ; if kind.proc <> internal process then 18703 42976 se w0 f37 ; 18704 42978 je. j3. ; enabled goto result 3; 18705 42980 18705 42980 rl. w1 d2. ; if parent.proc addr <> sender 18706 42982 se w1 (x3+a34) ; then enabled goto error 3; 18707 42984 je. j3. ; 18708 42986 18708 42986 al w2 0 ; end chain:= children bits:= 0; 18709 42988 rs. w2 d15. ; w3:= proc addr; 18710 42990 ds. w3 d14. ; 18711 42992 al w2 f48 ; w2:= new state:= wait stop by parent; 18712 42994 jd. (d12.) ; disabled return; 18713 42996 18713 42996 e26: je. w3 e24. ; test found: test format; 18714 42998 jl. j3. ; goto error 3; 18715 43000 18715 43000 ; procedure chain and add children; 18716 43000 ; connects proc addr to the the chain through wait addresses which 18717 43000 ; ends in end chain and exits via add children 18718 43000 ; call: jl. w3 e18. 18719 43000 ; return: all registers changed 18720 43000 18720 43000 b. g0 ; begin 18721 43000 w. ; 18722 43000 e18: dl. w2 d15. ; chain and add children: 18723 43002 rs w2 x1+f26 ; wait addr.proc addr:= end chain; 18724 43004 rs. w1 d15. ; end chain:= proc addr; 18725 43006 18725 43006 ; procedure add children; 18726 43006 ; searches through all internal processes and adds to children bits 18727 43006 ; the identification bit for all processes with parent = proc addr; 18728 43006 ; call: jl. w3 e19. 18729 43006 ; return: all registers changed 18730 43006 18730 43006 e19: c.(:a92>19a.1:) -1 ; if test call included then 18731 43006 ds w3 b34 ; test output (e19); 18732 43006 jd. w3 e29. ; 18733 43006 z. rs. w3 d12. ; add children: save return; 18734 43008 dl. w1 d14. ; 18735 43010 rl w3 b6 ; 18736 43012 18736 43012 g0: rl w2 x3 ; for w3:= first internal in name table 18737 43014 sn w1 (x2+a34) ; step 2 until last proc do 18738 43016 lo w0 x2+a14 ; if parent.name table(w3) = 18739 43018 al w3 x3+2 ; proc addr then 18740 43020 se w3 (b7) ; children bits:= children bits 18741 43022 jl. g0. ; or ident bit.name table(w3); 18742 43024 rs. w0 d13. ; 18743 43026 jl. (d12.) ; return; 18744 43028 18744 43028 e. ; end chain/add children; 18745 43028 18745 43028 ; procedure next proc (result: proc addr, new state); 18746 43028 ; finds proc addr corresponding to one of the bits in children bits, 18747 43028 ; removes the corresponding bit in children bits, and returns disabled 18748 43028 ; with new state = wait stop by ancestor and proc addr defined. 18749 43028 ; call: jl. w3 e20. 18750 43028 ; return: w2 = new state 18751 43028 ; w3 = proc addr 18752 43028 ; w0,w1 changed. 18753 43028 ; return 2: no more children 18754 43028 18754 43028 b. g0 ; begin 18755 43028 w. ; next proc: 18756 43028 e20: c.(:a92>19a.1:) -1 ; if test call included then 18757 43028 ds w3 b34 ; test output (e20); 18758 43028 jd. w3 e29. ; 18759 43028 z. rl. w1 d13. ; 18760 43030 sn w1 0 ; if children bits = 0 then 18761 43032 jd x3+2 ; return 2; 18762 43034 18762 43034 rs. w3 d12. ; more children: save return; 18763 43036 rl w3 b6 ; w3:= first internal process in name tb; 18764 43038 18764 43038 g0: rl w2 x3 ; loop: w2:= name table(w3); 18765 43040 al w3 x3+2 ; w3:= w3+2; 18766 43042 so w1 (x2+a14) ; if children bits and ident bit.2 = 0 18767 43044 jl. g0. ; then goto loop; 18768 43046 18768 43046 ws w1 x2+a14 ; proc addr:= w2; 18769 43048 ds. w2 d14. ; children bits:= 18770 43050 al w3 x2 ; children bits - ident bit.w2; 18771 43052 al w2 f50 ; new state:= wait stop by ancestor; 18772 43054 jd. (d12.) ; 18773 43056 18773 43056 e. ; end next proc; 18774 43056 18774 43056 18774 43056 18774 43056 ; procedure create next wrk-name 18775 43056 ; supplies a wrk-name in name.work 18776 43056 ; 18777 43056 ; a wrk-name has the format: wrk<6 octal digits> 18778 43056 ; 18779 43056 ; call: jl. w3 e23. 18780 43056 ; 18781 43056 ; return: name.work defined 18782 43056 ; all regs undef 18783 43056 18783 43056 b. g10, h10 w. 18784 43056 18784 43056 e23: ; test name: 18785 43056 dl. w1 h0. ; increase(last wrkname) octal; 18786 43058 aa. w1 h3. ; 18787 43060 lo. w0 h1. ; (notice: a carry from one character is 18788 43062 la. w0 h2. ; propagated to next char and so on, 18789 43064 lo. w1 h1. ; by means of the special mask) 18790 43066 la. w1 h2. ; 18791 43068 ds. w1 h0. ; 18792 43070 18792 43070 al. w1 v5. ; move wrk-name 18793 43072 jl. w2 e32. ; to name.work; 18794 43074 h0=k+4 ; wrk-digits ; 18795 43074 <:wrk000000:>,0 ; last wrk-name 18796 43082 18796 43082 h1: <:000:> ; mask to convert to digits 18797 43084 h2: <:777:> ; mask to eliminate superflouos carries 18798 43086 200<16+200<8+200 ; double-mask to increase octally 18799 43088 h3: 200<16+200<8+200+1; (= all ones - <:888888:> + 1) 18800 43090 18800 43090 e. ; 18801 43090 18801 43090 18801 43090 18801 43090 ; procedure test format 18802 43090 ; 18803 43090 ; test whether the format of name.work corresponds to 18804 43090 ; a legal identifier. 18805 43090 ; a legal name consists of a small letter followed by at most 18806 43090 ; 10 small letters or digits, filled up with null-chars 18807 43090 ; until 4 words. 18808 43090 ; f16 <= value of digit <= f17 (initially: digits 0-9) 18809 43090 ; f18 <= value of small letter <= f19 (initially: letters a-aa) 18810 43090 ; 18811 43090 ; call: jl. w3 e24. 18812 43090 ; error return: result 6, if nameformat illegal 18813 43090 ; return: nameformat ok 18814 43090 ; all regs undef 18815 43090 18815 43090 b. g10 w. 18816 43090 18816 43090 e24: ; test format: 18817 43090 rs. w3 d12. ; save(return); 18818 43092 al. w2 v5. ; name pointer := addr of name.work; 18819 43094 18819 43094 bz w0 x2 ; test start of name: 18820 43096 sl w0 f18<4 ; if first char of name < minimum letter then 18821 43098 jl. g3. ; goto result 6; 18822 43100 jl. j6. ; goto get word; 18823 43102 18823 43102 g1: ; test next char: 18824 43102 ; w0 = partial word ( <> 0 ) 18825 43102 ; (i.e. contains at least one character, 18826 43102 ; which must be left justified) 18827 43102 ; w1 = current word 18828 43102 ; w2 = name pointer: even == before null-char 18829 43102 ; odd == after null-char 18830 43102 ; w3 = 1 18831 43102 so w2 2.1 ; if before null-char then 18832 43104 ld w0 8 ; char := next char from partial word + 1 shift 8; 18833 43106 ; (partial word := partial word shift 8); 18834 43106 ; (i.e. if after null-char then illegal name) 18835 43106 sh w3 f17+1<8; 18836 43108 al w3 x3+f18-f16; if neither letter nor digit then 18837 43110 sl w3 f18+1<8; 18838 43112 sl w3 f19+1+1<8; 18839 43114 jl. j6. ; goto result 6; i.e. illegal name 18840 43116 18840 43116 g2: ; test rest of partial word: 18841 43116 al w3 1 ; (prepare for next char and for making nameptr odd) 18842 43118 se w0 0 ; if partial word <> 0 then 18843 43120 jl. g1. ; goto test next char; 18844 43122 18844 43122 sz w1 255 ; if last char in current word = null then 18845 43124 sz w2 2.1 ; after null-char := true; 18846 43126 lo w2 6 ; (i.e. make name pointer odd) 18847 43128 18847 43128 al w2 x2+2 ; increase(name pointer); 18848 43130 18848 43130 g3: ; get word: 18849 43130 rl w1 x2 ; current word := name (name pointer); 18850 43132 al w0 x1 ; partial word := current word; 18851 43134 sh. w2 v15. ; if name pointer < last addr of name.word then 18852 43136 jl. g2. ; goto test rest of partial word; 18853 43138 18853 43138 sz w2 2.1 ; if after null-char then 18854 43140 jl. (d12.) ; return; 18855 43142 jl. j6. ; goto result 6; (i.e. more than 11 chars) 18856 43144 18856 43144 e. ; 18857 43144 18857 43144 18857 43144 ; procedure remove area (intproc,areaproc); 18858 43144 ; intproc is removed as user and as reserver of area proc. 18859 43144 ; call: w1= intproc, w3=area proc 18860 43144 ; disabled call with link in w2 18861 43144 18861 43144 b.g30,h7 w. ; begin 18862 43144 ; remove area: 18863 43144 18863 43144 h0: 0 ; save w1: init proc 18864 43146 h1: 0 ; save w2: link 18865 43148 h2: 0 ; save w3: area proc 18866 43150 0 ; write access counter 18867 43152 h6: 0 ; read access counter 18868 43154 0 ; lower base.proc 18869 43156 h7: 0 ; upper base.proc 18870 43158 18870 43158 e25: rl w0 x3+a53 ; if initproc not user of areaproc 18871 43160 so w0 (x1+a14) ; then enable return 18872 43162 je x2+0 ; 18873 43164 ws w0 x1+a14 ; users.area:=users.area-id bit.initproc 18874 43166 rs w0 x3+a53 ; 18875 43168 la w0 x3+a52 ; if initproc is reserver then 18876 43170 rs w0 x3+a52 ; reservers.area:=0 18877 43172 al w0 1 ; areaclaim.initproc:= 18878 43174 ba w0 x1+a20 ; areaclaim.initproc+1; 18879 43176 hs w0 x1+a20 ; 18880 43178 rl w0 x3+a53 ; 18881 43180 se w0 0 ; if area not removed then 18882 43182 je x2+0 ; enable, return; 18883 43184 sn w0 (x3+a411) ; w0=0 used below.... 18884 43186 se w0 (x3+a412) ; if access counters<>0,0 then 18885 43188 jl. g1. ; name(0).area:=0; 18886 43190 rs w0 x3+a11 ; procdesc(doc).area:=0; 18887 43192 rs w0 x3+a50 ; 18888 43194 je x2+0 ; enable, return; 18889 43196 ; save statistical information in auxiliary catalog. 18890 43196 g1: ds. w2 h0.+2 ; save init proc, link; 18891 43198 rs. w3 h2. ; save area proc; 18892 43200 dl w2 x3+a49 ; 18893 43202 ds. w2 v2. ; base.work:=base.proc 18894 43204 ds. w2 h7. ; save base.proc 18895 43206 dl w2 x3+a62+2 ; move docname.area to docname.work 18896 43208 ds. w2 v30. ; 18897 43210 dl w2 x3+a62+6 ; 18898 43212 ds. w2 v31. ; 18899 43214 dl w2 x3+a11+2 ; move name.area to name.work 18900 43216 ds. w2 v13. ; 18901 43218 dl w2 x3+a11+6 ; 18902 43220 ds. w2 v14. ; 18903 43222 rs w0 x3+a11 ; name(0).area:=0; 18904 43224 rs w0 x3+a50 ; proc desc(doc).area:=0; 18905 43226 rl. w1 h0. ; w1:= initproc 18906 43228 dl w0 x3+a412 ; 18907 43230 ds. w0 h6. ; access counters:=access counters.area; 18908 43232 je. w3 e45. ; enable, find chain(docname.work) 18909 43234 v11 ; 18910 43236 jl. g2. ; NOT FOUND: result 3 18911 43238 18911 43238 rs. w2 d4. ; curdoc:= chain; 18912 43240 jl. w3 e0. ; set aux cat 18913 43242 jl. w3 e46. ; search best entry 18914 43244 jl. g2. ; NOT FOUND: enable return 18915 43246 sn. w0 (h7.-2) ; if base.entry<> base.proc 18916 43248 se. w1 (h7.) ; then enable return 18917 43250 jl. g2. ; (area describes a temp entry on curdoc) 18918 43252 dl w1 b13+2 ; 18919 43254 ld w1 5 ; 18920 43256 dl. w2 h6. ; 18921 43258 se w1 0 ; if write access counter<>0 then 18922 43260 rs. w0 v11. ; last change.work:=short clock; 18923 43262 sn w1 0 ; if write access counter<>0 or 18924 43264 se w2 0 ; if read access counter<>0 then 18925 43266 rs. w0 v8. ; last used.work := short clock 18926 43268 wa. w1 v12. ; 18927 43270 wa. w2 v32. ; 18928 43272 ds. w2 v32. ; update access counters; 18929 43274 jl. w3 e12. ; set curr entry; 18930 43276 g2: jl. w3 e1. ; maincat: set main catalog; 18931 43278 18931 43278 ; find all buffers sent to this area process and insert result 2. 18932 43278 g3: rl. w3 h2. ; clear bufs: 18933 43280 al w0 2 ; w3:=area process; 18934 43282 rl w1 b8+4 ; w1:=first message buffer 18935 43284 18935 43284 g4: sn w3 (x1+a141) ; for all messages do 18936 43286 rs w0 x1+a141 ; if receiver.message:=areaproc then 18937 43288 al w1 x1+a6 ; receiver.message:=2 (i.e. result 2); 18938 43290 sh w1 (b8+6) ; 18939 43292 jl. g4. ; 18940 43294 18940 43294 rl. w1 h0. ; w1:=init proc; 18941 43296 je. (h1.) ; exit: enable, return; 18942 43298 e. ; 18943 43298 18943 43298 18943 43298 18943 43298 ; the following complex of procedures take care of moves 18944 43298 ; in general the call must be like this: 18945 43298 ; call: al w0 <bytes to move> (must be even) 18946 43298 ; al. w1 <to-address> 18947 43298 ; al. w2 <from-address> 18948 43298 ; jl. w3 move 18949 43298 ; return: all regs undef 18950 43298 ; 18951 43298 ; procedure move entry 18952 43298 ; procedure move name 18953 43298 ; procedure move 18954 43298 ; 18955 43298 18955 43298 b. g10, h10 w. 18956 43298 18956 43298 e33: am f0-8 ; move entry: bytes = size of catalog entry 18957 43300 e32: al w0 8 ; move name: bytes = size of name 18958 43302 e31: ; move: 18959 43302 rs. w3 h0. ; save(return); 18960 43304 18960 43304 ac w3 (0) ; remaining := - bytes; 18961 43306 sz w3 1<1 ; if odd number of words to move then 18962 43308 jl. g5. ; goto move single word; 18963 43310 18963 43310 g1: ; move double words: 18964 43310 rs. w3 h1. ; save(remaining); 18965 43312 sl w3 h5 ; if remaining does no exceed size of move-table 18966 43314 jl. x3+h4. ; then switch out through table; 18967 43316 ; (otherwise move a whole portion) 18968 43316 h3: ; start of move-table: 18969 43316 dl w0 x2+30 ; 18970 43318 ds w0 x1+30 ; 18971 43320 dl w0 x2+26 ; 18972 43322 ds w0 x1+26 ; 18973 43324 dl w0 x2+22 ; 18974 43326 ds w0 x1+22 ; 18975 43328 dl w0 x2+18 ; 18976 43330 ds w0 x1+18 ; 18977 43332 dl w0 x2+14 ; 18978 43334 ds w0 x1+14 ; 18979 43336 dl w0 x2+10 ; 18980 43338 ds w0 x1+10 ; 18981 43340 dl w0 x2+6 ; 18982 43342 ds w0 x1+6 ; 18983 43344 dl w0 x2+2 ; 18984 43346 ds w0 x1+2 ; 18985 43348 h4: ; top of move-table: 18986 43348 h5 = h3 - h4 ; size of move-table (notice: negative) 18987 43348 18987 43348 al w1 x1-h5 ; increase(to-address); 18988 43350 al w2 x2-h5 ; increase(from-address); 18989 43352 rl. w3 h1. ; restore(remaining); 18990 43354 al w3 x3-h5 ; decrease(remaining); (remember: negative) 18991 43356 sh w3 -1 ; if not all moved yet then 18992 43358 jl. g1. ; goto move double words; 18993 43360 18993 43360 jl. (h0.) ; return; 18994 43362 18994 43362 g5: ; move single word: 18995 43362 rl w0 x2+0 ; 18996 43364 rs w0 x1+0 ; 18997 43366 al w1 x1+2 ; increase(to-address); 18998 43368 al w2 x2+2 ; increase(from-address); 18999 43370 al w3 x3+2 ; decrease(remaining); (remember: negative) 19000 43372 jl. g1. ; goto move double words; 19001 43374 19001 43374 h0: 0 ; saved return 19002 43376 h1: 0 ; remaining bytes (negative, multiplum of 4 bytes) 19003 43378 19003 43378 e. ; 19004 43378 19004 43378 19004 43378 ; procedure compare names 19005 43378 ; 19006 43378 ; the names at name.work and name.param are compared 19007 43378 ; 19008 43378 ; call: w2 = chain addr, w3 = link 19009 43378 ; exit: w0w1 = undef, w2w3 = unchanged 19010 43378 ; 19011 43378 ; return: link+0: not same name 19012 43378 ; link+2: the names are equal 19013 43378 19013 43378 e41: ; compare names: 19014 43378 dl. w1 v13. ; 19015 43380 sn w0 (x2+f55+0) ; if first part of name.work <> 19016 43382 se w1 (x2+f55+2) ; first part of name.chain then 19017 43384 jl x3 ; return not same; 19018 43386 19018 43386 dl. w1 v14. ; if second part of name.work <> 19019 43388 sn w0 (x2+f55+4) ; 19020 43390 se w1 (x2+f55+6) ; second part of name.chain then 19021 43392 jl x3 ; return not same; 19022 43394 19022 43394 jl x3+2 ; return same; 19023 43396 19023 43396 19023 43396 19023 43396 ; procedure for all named entries in cat do 19024 43396 ; 19025 43396 ; the namekey.work is computed, and the current catalog is searched for 19026 43396 ; entries with name = name.work. 19027 43396 ; for each such entry the found-action is called 19028 43396 ; 19029 43396 ; call: jl. w3 e42. 19030 43396 ; jl. no more 19031 43396 ; <action for found entry> 19032 43396 ; w0w1 = base.entry, w2 = entry 19033 43396 ; (maybe save w2) 19034 43396 ; ... 19035 43396 ; (maybe restore w2, if changed) 19036 43396 ; jl x3 19037 43396 ; 19038 43396 ; error return: result 2, in case of io-error 19039 43396 ; 19040 43396 ; return: link+0: no more entries (all regs undef) 19041 43396 ; link+2: w0w1 = base.entry, w2 = entry, w3 = continue search 19042 43396 19042 43396 b. h0 w. 19043 43396 19043 43396 e42: ; for all named entries in cat do: 19044 43396 rs. w3 h0. ; 19045 43398 jl. w3 e3. ; compute namekey.work; 19046 43400 ls w2 -3 ; segment := key; 19047 43402 19047 43402 jl. w3 e14. ; for all key entries do 19048 43404 jl. (h0.) ;+2: no more: goto no-more action; 19049 43406 19049 43406 ; for each entry the name must be tested: 19050 43406 dl. w1 v13. ; 19051 43408 sn w0 (x2+f5+0) ; 19052 43410 se w1 (x2+f5+2) ; if name.entry <> name.work then 19053 43412 jl x3 ; return; 19054 43414 19054 43414 dl. w1 v14. ; 19055 43416 sn w0 (x2+f5+4) ; 19056 43418 se w1 (x2+f5+6) ; 19057 43420 jl x3 ; 19058 43422 19058 43422 ; the name.entry was correct, now exit to check the base.entry 19059 43422 dl w1 x2+f2 ; w0w1 := base.entry; 19060 43424 am. (h0.) ; 19061 43426 jl +2 ; call found-action and return; 19062 43428 19062 43428 h0: 0 ; saved return; 19063 43430 19063 43430 e. ; 19064 43430 19064 43430 19064 43430 19064 43430 ; procedure for all named procs in part of nametable do 19065 43430 ; 19066 43430 ; the specified part of nametable is scanned for processes with 19067 43430 ; name.proc = name.work 19068 43430 ; for each process the found-action is called 19069 43430 ; 19070 43430 ; call: jl. w3 e43. 19071 43430 ; <first> ; e.g. b5 (=first area process in nametable) 19072 43430 ; <top> ; e.g. b6 (=top area process in nametable) 19073 43430 ; jl. no more 19074 43430 ; <action for found process> 19075 43430 ; w2 = nametable address 19076 43430 ; (maybe save w2) 19077 43430 ; ... 19078 43430 ; (maybe restore w2) 19079 43430 ; jl x3 19080 43430 ; 19081 43430 ; return: link+4: no more processes (all regs undef) 19082 43430 ; link+6: w0w1 = base.process, w2 = nametable address, w3 = continue 19083 43430 19083 43430 b. g10, h10 w. 19084 43430 19084 43430 e43: ; for all processes in part of nametable do: 19085 43430 rl w2 (x3+0) ; get first nametable address; 19086 43432 rl w0 (x3+2) ; get top nametable address; 19087 43434 al w3 x3+6 ; 19088 43436 ds. w0 h1. ; save(found-action address, top nametable address); 19089 43438 19089 43438 al w2 x2-2 ; 19090 43440 g1: ; next process: 19091 43440 dl. w1 v13. ; 19092 43442 g2: ; 19093 43442 al w2 x2+2 ; increase(nametable address); 19094 43444 sn. w2 (h1.) ; if nametable address = top name table address then 19095 43446 jl. g10. ; goto no-more action; 19096 43448 19096 43448 rl w3 x2+0 ; proc := word(nametable address); 19097 43450 19097 43450 sn w0 (x3+a11+0) ; 19098 43452 se w1 (x3+a11+2) ; if name.proc <> name.work then 19099 43454 jl. g2. ; goto next process; 19100 43456 19100 43456 dl. w1 v14. ; 19101 43458 sn w0 (x3+a11+4) ; 19102 43460 se w1 (x3+a11+6) ; 19103 43462 jl. g1. ; 19104 43464 19104 43464 ; the process-name was correct, now exit to check the base.process 19105 43464 dl w1 x3+a49 ; w0w1 := base.process; 19106 43466 al. w3 g1. ; return := next process; 19107 43468 jl. (h0.) ; call found-action; 19108 43470 19108 43470 g10: am. (h0.) ; no-more action: 19109 43472 jl -2 ; goto no-more; 19110 43474 19110 43474 h0: 0 ; return to found-action 19111 43476 h1: 0 ; top name table address 19112 43478 19112 43478 e. ; 19113 43478 19113 43478 19113 43478 19113 43478 ; procedure find idle process in part of nametable 19114 43478 ; 19115 43478 ; the specified part of nametable is scanned until an idle process is found 19116 43478 ; (notice: it must exist) 19117 43478 ; 19118 43478 ; call: jl. w3 e44. 19119 43478 ; <first> ; e.g. b5 (= first area process in name table) 19120 43478 ; 19121 43478 ; return: cur proc nametable address is defined 19122 43478 ; w0 = 0, w1 = unchanged, w2 = proc, w3 = undef 19123 43478 19123 43478 b. g10 w. 19124 43478 19124 43478 e44: ; find idle process in part of nametable: 19125 43478 al w0 0 ; 19126 43480 rl w2 (x3) ; nametable address := param; 19127 43482 se w2 (b6) ; (if internal processes then skip procfunc itself) 19128 43484 al w2 x2-2 ; 19129 43486 g1: ; next process: 19130 43486 al w2 x2+2 ; increase(nametable address); 19131 43488 am (x2) ; if name.process(nametable address) <> 0 then 19132 43490 se w0 (+a11) ; 19133 43492 jl. g1. ; goto next process; 19134 43494 19134 43494 rs. w2 d11. ; save(cur proc nametable addr); 19135 43496 rl w2 x2 ; w2 := proc; 19136 43498 jl x3+2 ; return; 19137 43500 19137 43500 e. ; 19138 43500 19138 43500 19138 43500 19138 43500 ; procedure find chain 19139 43500 ; 19140 43500 ; searches the chaintables in order to find a chainhead with 19141 43500 ; docname.chain = name 19142 43500 ; 19143 43500 ; call: jl. w3 e45. 19144 43500 ; <name address> 19145 43500 ; 19146 43500 ; error return: result 6, if name(0) = 0 19147 43500 ; 19148 43500 ; return: link+2: chain not found (all regs undef) 19149 43500 ; link+4: chain found 19150 43500 ; w2 = chain 19151 43500 ; other regs undef 19152 43500 19152 43500 b. g10, h10 w. 19153 43500 19153 43500 e45: ; find chain: 19154 43500 rl w1 x3 ; w1 := start of name; 19155 43502 al w1 x1+2 ; 19156 43504 al w2 x1+4 ; 19157 43506 ds. w2 h2. ; save (first double, last double); 19158 43508 19158 43508 al w3 x3+2 ; 19159 43510 rs. w3 h0. ; save (error return address); 19160 43512 19160 43512 rl w3 b22 ; entry := first drumchain in name table; 19161 43514 al w3 x3-2 ; 19162 43516 19162 43516 g1: ; next chain: 19163 43516 dl. w1 (h2.) ; w0w1 := last double word of name; 19164 43518 g2: ; 19165 43518 al w3 x3+2 ; increase (entry); 19166 43520 sn w3 (b24) ; if all chains tested then 19167 43522 jl. (h0.) ; error return; 19168 43524 19168 43524 rl w2 x3 ; chain := name table(entry); 19169 43526 sn w0 (x2+f61+4) ; 19170 43528 se w1 (x2+f61+6) ; if name.chain <> name then 19171 43530 jl. g2. ; goto next chain; 19172 43532 19172 43532 dl. w1 (h1.) ; 19173 43534 sn w0 (x2+f61+0) ; 19174 43536 se w1 (x2+f61+2) ; 19175 43538 jl. g1. ; 19176 43540 19176 43540 ; a chain was found, with docname.chain = name 19177 43540 ; check that the chain is not empty 19178 43540 19178 43540 sn w0 0 ; if name(0) = 0 then 19179 43542 jl. j6. ; result 6; i.e. nameformat illegal; 19180 43544 19180 43544 am. (h0.) ; 19181 43546 jl +2 ; return ok; 19182 43548 19182 43548 h0: 0 ; return 19183 43550 h1: 0 ; address of first double word of name 19184 43552 h2: 0 ; address of last double word of name 19185 43554 19185 43554 e. ; 19186 43554 19186 43554 19186 43554 19186 43554 ; procedure search best entry in catalog 19187 43554 ; 19188 43554 ; searches the current catalog for an entry with name.entry = name.work 19189 43554 ; and with the narrowest interval containing base.work 19190 43554 ; the entry is moved to work 19191 43554 ; 19192 43554 ; call: jl. w3 e46. 19193 43554 ; jl. not found 19194 43554 ; jl. found 19195 43554 ; 19196 43554 ; error return: result 2, in case of io-error 19197 43554 ; result 6, in case of nameformat illegal 19198 43554 ; 19199 43554 ; return: link+0: no entry with name.entry = name.work was found 19200 43554 ; with an interval containing base.work 19201 43554 ; (all regs undef) 19202 43554 ; link+2: an entry was found: 19203 43554 ; w0w1 = base.entry 19204 43554 ; cur entry (and -segment) is defined 19205 43554 ; entry is moved to work 19206 43554 ; (all regs undef) 19207 43554 19207 43554 b. g20, h10 w. 19208 43554 19208 43554 e46: ; search best entry in catalog: 19209 43554 rs. w3 h0. ; save(return); 19210 43556 19210 43556 dl w1 b40 ; best base := system base; 19211 43558 ds. w1 h2. ; 19212 43560 al w0 0 ; cur entry := 0; 19213 43562 rs. w0 d3. ; 19214 43564 19214 43564 jl. w3 e42. ; for all named entries in catalog do 19215 43566 jl. g5. ;+2: no more: goto test any found; 19216 43568 19216 43568 ; w0w1 = base.entry, w2 = entry, w3 = continue search 19217 43568 sh. w0 (v1.) ; if base.entry does not contain base.work 19218 43570 sh. w0 (h1.) ; or base.entry is not better than best base then 19219 43572 jl x3 ; continue search; 19220 43574 19220 43574 sl. w1 (v2.) ; 19221 43576 sl. w1 (h2.) ; 19222 43578 jl x3 ; 19223 43580 19223 43580 ; a better entry was found: save new base as best base 19224 43580 bs. w0 1 ; (code trick) 19225 43582 al w1 x1+1 ; (code trick) 19226 43584 ds. w1 h2. ; best base := base.entry; 19227 43586 19227 43586 ; procedure save position 19228 43586 ; 19229 43586 ; call: w2 = entry 19230 43586 ; jl. w3 e48. 19231 43586 ; exit: w2,w3 = unchanged 19232 43586 19232 43586 e48: ; save position: 19233 43586 rl. w1 d8.+f36; cur entry segment := current segment; 19234 43588 ds. w2 d3. ; cur entry := entry; 19235 43590 jl x3 ; return;; 19236 43592 19236 43592 g5: ; test any found: 19237 43592 rl. w2 d3. ; if cur entry = 0 then 19238 43594 sn w2 0 ; goto test format; 19239 43596 jl. g10. ; (i.e. no entries was found, maybe illegal name) 19240 43598 19240 43598 jl. w3 e11. ; get current entry segment; 19241 43600 al. w1 d1. ; 19242 43602 rl. w2 d3. ; 19243 43604 jl. w3 e33. ; move entry to work; 19244 43606 19244 43606 dl. w1 v2. ; w0w1 := base.work; 19245 43608 am. (h0.) ; ok return; 19246 43610 jl +2 ; 19247 43612 19247 43612 g10: ; test format: 19248 43612 jl. w3 e24. ; test format; 19249 43614 jl. (h0.) ; not-found return; 19250 43616 19250 43616 h0: 0 ; saved return 19251 43618 h1: 0 ; lower best interval - 1 19252 43620 h2: 0 ; upper best interval + 1 19253 43622 19253 43622 19253 43622 19253 43622 19253 43622 ; procedure search best process in nametable 19254 43622 ; 19255 43622 ; searches the nametable for a process with name.process = name.work 19256 43622 ; and with the narrowest interval containing base.work 19257 43622 ; 19258 43622 ; call: jl. w3 e47. 19259 43622 ; <first> ; e.g. b5 (=first area process in nametable) 19260 43622 ; <top> ; e.g. b6 (=top area process in nametable) 19261 43622 ; jl. not found 19262 43622 ; jl. found 19263 43622 ; 19264 43622 ; return: link+4: no process with name.process = name.work was found 19265 43622 ; (all regs undef) 19266 43622 ; link+6: a process was found: 19267 43622 ; cur process nametable address is defined 19268 43622 ; w0w1 = base.process, w2 = process 19269 43622 ; (other regs undef) 19270 43622 19270 43622 19270 43622 e47: ; search best process in nametable: 19271 43622 rs. w3 h0. ; save(return); 19272 43624 19272 43624 dl w1 x3+2 ; get search limits; 19273 43626 ds. w1 h5. ; 19274 43628 19274 43628 dl w1 b40 ; best base := system base; 19275 43630 ds. w1 h2. ; 19276 43632 al w0 0 ; cur proc nametable address := 0; 19277 43634 rs. w0 d11. ; 19278 43636 19278 43636 jl. w3 e43. ; for all named processes in part of nametable do 19279 43638 0 ; e.g. b3 ; (start limit) 19280 43640 h5: 0 ; e.g. b7 ; (top limit) 19281 43642 jl. g20. ;+6: no more: goto test any found; 19282 43644 19282 43644 ; w0w1 = base.process, w2 = nametable address, w3 = continue address 19283 43644 sh. w0 (v1.) ; if base.process does not contain base.work 19284 43646 sh. w0 (h1.) ; or base.process in not better than best base then 19285 43648 jl x3 ; continue search; 19286 43650 19286 43650 sl. w1 (v2.) ; 19287 43652 sl. w1 (h2.) ; 19288 43654 jl x3 ; 19289 43656 19289 43656 ; a better process was found, save new base and nametable address 19290 43656 bs. w0 1 ; (code trick) 19291 43658 al w1 x1+1 ; (code trick) 19292 43660 ds. w1 h2. ; best base := base.process; 19293 43662 19293 43662 rs. w2 d11. ; cur process nametable address := nametable address 19294 43664 jl x3 ; continue search; 19295 43666 19295 43666 g20: ; test any found: 19296 43666 rl. w2 d11. ; 19297 43668 rl. w3 h0. ; 19298 43670 sn w2 0 ; if cur proc nametable address = 0 then 19299 43672 jl x3+4 ; not-found return; 19300 43674 19300 43674 rl w2 x2 ; proc := nametable (name table address); 19301 43676 dl w1 x2+a49 ; w0w1 := base.proc; 19302 43678 jl x3+6 ; ok-return; 19303 43680 19303 43680 e. ; 19304 43680 19304 43680 19304 43680 ; insert statinf. 19305 43680 ; this procedure moves the contents of the statarea of 19306 43680 ; the work area to the current entry (docname area). 19307 43680 ; 19308 43680 ; call: jl. w3 e49. 19309 43680 ; 19310 43680 ; return: all registers destroyed 19311 43680 19311 43680 e49: rl. w1 d3. ; insert statinf; 19312 43682 al w1 x1+f11 ; 19313 43684 al. w2 d30. ; 19314 43686 jl. e32. ; goto move name; 19315 43688 19315 43688 19315 43688 ; get statinf. 19316 43688 ; this procedure moves the contents of the statarea in current entry 19317 43688 ; to the work area. 19318 43688 ; 19319 43688 ; call: jl. w3 e50. 19320 43688 ; 19321 43688 ; return: all registers destroyed 19322 43688 19322 43688 e50: al. w1 d30. ; get statinf: 19323 43690 rl. w2 d3. ; 19324 43692 al w2 x2+f11 ; 19325 43694 jl. e32. ; goto move name; 19326 43696 19326 43696 19326 43696 19326 43696 ; the following set of procedures handles the conversion of 19327 43696 ; logical sender-addresses (in case of rc8000) 19328 43696 ; 19329 43696 ; they all have a common call- and return-sequence: 19330 43696 ; 19331 43696 ; call: jl. w2 e<number> 19332 43696 ; return: w2 = abs address 19333 43696 ; w0, w1, w3 unchanged 19334 43696 19334 43696 b. g10, h10 w. 19335 43696 19335 43696 e60: ; get w1-abs: 19336 43696 rs. w2 h0. ; 19337 43698 al w2 a29 ; w2 := rel of save w1; 19338 43700 jl. g0. ; goto get abs; 19339 43702 19339 43702 e61: ; get w2-abs: 19340 43702 rs. w2 h0. ; 19341 43704 al w2 a30 ; w2 := rel of save w2; 19342 43706 jl. g0. ; goto get abs; 19343 43708 19343 43708 e62: ; get w3-abs: 19344 43708 rs. w2 h0. ; 19345 43710 al w2 a31 ; w2 := rel of save w3; 19346 43712 19346 43712 g0: ; get abs: 19347 43712 am. (d2.) ; 19348 43714 rl w2 x2 ; w2 := saved wreg.sender (logical address); 19349 43716 19349 43716 g1: ; convert to abs: 19350 43716 c. 8000 ; if rc8000 then 19351 43716 am. (d2.) ; 19352 43718 wa w2 +a182 ; w2 := logical address + base.sender; 19353 43720 z. ; 19354 43720 jl. (h0.) ; return; 19355 43722 19355 43722 h0: 0 ; saved return 19356 43724 19356 43724 19356 43724 ; procedure get abs address 19357 43724 ; 19358 43724 ; call: al w2 <logical addr> 19359 43724 ; jl. w3 e63. 19360 43724 ; 19361 43724 ; return: w2 = abs address 19362 43724 ; w0, w1, w3 unchanged 19363 43724 19363 43724 e63: ; get abs address 19364 43724 rs. w3 h0. ; 19365 43726 jl. g1. ; goto convert to abs; 19366 43728 19366 43728 e. ; 19367 43728 19367 43728 19367 43728 19367 43728 ; the following set of procedures take care of all moves between 19368 43728 ; sender-process and procfunc. 19369 43728 ; 19370 43728 ; they all have a common call- and return-sequence: 19371 43728 ; 19372 43728 ; call: jl. w3 e<number> 19373 43728 ; return: all regs undef 19374 43728 19374 43728 b. h10 w. 19375 43728 19375 43728 ; size procfunc addres 19376 43728 19376 43728 h1: 8 , v5 ; name.work 19377 43732 h2: 8 , v11 ; docname.work 19378 43736 h3: f8 , v6 ; tail.work 19379 43740 h4: ; (chainhead) 19380 43740 h5: f0 , d1 ; entry.work 19381 43744 h6: 12 , v6 ; registers to tail.work 19382 43748 h7: 18 , v6 ; internal params to tail.work 19383 43752 h8: 10 , v5 ; name + nametable addr 19384 43756 h9: 4*a110+4 , d16 ; bs-claims to bs-params 19385 43760 19385 43760 ; moves from senders w1-area: 19386 43760 e76: am h7-h9 ; internal params to tail.work: 19387 43762 e75: am h9-h6 ; bs-claims to bs-params: 19388 43764 e74: am h6-h5 ; registers to tail.work: 19389 43766 e73: am h5-h3 ; complete entry to work: 19390 43768 e72: am h3-h2 ; tail to tail.work: 19391 43770 e71: am h2-h1 ; name to docname.work: 19392 43772 e70: dl. w1 h1.+2 ; name to name.work: 19393 43774 jl. w2 e60. ; w2 := abs address of w1-area; 19394 43776 jl. e31. ; goto move; 19395 43778 19395 43778 ; moves to senders w1-area: 19396 43778 e82: am h1-h5 ; name.work to name: 19397 43780 e81: am h5-h3 ; work to complete entry: 19398 43782 e80: dl. w1 h3.+2 ; tail.work to tail: 19399 43784 jl. w2 e60. ; w2 := abs address of w1-area; 19400 43786 rx w2 2 ; exchange ..to.. and ..from..; 19401 43788 jl. e31. ; goto move; 19402 43790 19402 43790 ; moves from senders w2-area: 19403 43790 e85: dl. w1 h2.+2 ; name to docname.work: 19404 43792 jl. w2 e61. ; w2 := abs address of w2-area; 19405 43794 jl. e31. ; goto move; 19406 43796 19406 43796 ; moves from senders w3-area: 19407 43796 e92: am h4-h2 ; chainhead to work: 19408 43798 e91: am h2-h1 ; name to docname.work: 19409 43800 e90: dl. w1 h1.+2 ; name to name.work: 19410 43802 jl. w2 e62. ; w2 := abs address of w3-area; 19411 43804 jl. e31. ; goto move; 19412 43806 19412 43806 ; moves to senders w3-area: 19413 43806 e96: am h8-h1 ; name and nametable addr to name etc.: 19414 43808 e95: dl. w1 h1.+2 ; name.work to name: 19415 43810 jl. w2 e62. ; w2 := abs address of w3-area; 19416 43812 rx w2 2 ; exchange ..to.. and ..from..; 19417 43814 jl. e31. ; goto move; 19418 43816 19418 43816 e. ; 19419 43816 19419 43816 19419 43816 19419 43816 ; the following set of procedures handles the interpretation 19420 43816 ; of the function-tables. 19421 43816 ; 19422 43816 ; most of the entries leave w0 and w2 unchanged 19423 43816 19423 43816 b. g20, h10 w. 19424 43816 19424 43816 h0 = 1 ; size of instructions (in bytes) 19425 43816 19425 43816 h1: 0 ; current instruction pointer 19426 43818 ; (points at instruction being interpreted) 19427 43818 h2: 0 ; first free in stack 19428 43820 h3: 0, r.3 ; stack 19429 43826 19429 43826 c.(:a92>22a.1:)-1 19430 43826 m. test buffer pointers (first, last, next) 19431 43826 h4: d49 ; first of test buffer 19432 43826 h5: d50 ; top of test buffer 19433 43826 h6: d49 ; current test address 19434 43826 z. 19435 43826 19435 43826 19435 43826 n2: am h0 ; skip 2 instructions: 19436 43828 n1: am h0 ; skip 1 instruction: 19437 43830 n0: al w3 h0 ; next instruction: 19438 43832 g0: wa. w3 h1. ; w3 := abs addr of next instruction byte; 19439 43834 g1: rs. w3 h1. ; save (cur instruction ptr); 19440 43836 19440 43836 ; test start: 19441 43836 c.(:a92>22a.1:)-1 19442 43836 rs. w3 (h6.) ; save (cur instr ptr) in test buffer; 19443 43836 rl. w3 h6. ; 19444 43836 al w3 x3+2 ; increase (test buffer ptr); 19445 43836 sl. w3 (h5.) ; (unless outside buffer); 19446 43836 rl. w3 h4. ; 19447 43836 rs. w3 h6. ; 19448 43836 rl. w3 h1. ; (restore (cur instr ptr) ) 19449 43836 z. 19450 43836 ; test end 19451 43836 19451 43836 bz w3 x3 ; w3 := instruction byte (positive integer); 19452 43838 ; when the function is entered, w0, w1 and w2 are unchanged from last 19453 43838 ; function call. 19454 43838 ; w3 = return to next instruction 19455 43838 jl. w3 x3+n50. ; goto function (w3); 19456 43840 jl. n0. ; (if it was a procedure then goto next instruction) 19457 43842 19457 43842 n6: am h0 ; goto-action 2: goto second param; 19458 43844 n5: al w3 h0 ; goto-action 1: goto first param; 19459 43846 wa. w3 h1. ; w3 := abs address of param byte; 19460 43848 ba w3 x3 ; w3 := abs addr of next instruction; 19461 43850 jl. g1. ; goto save cur instruction address; 19462 43852 19462 43852 ; procedure next param 19463 43852 ; 19464 43852 ; call: jl. w3 n10. 19465 43852 ; return: w0 = next param (signed integer) 19466 43852 19466 43852 n10: al w0 h0 ; next param: 19467 43854 wa. w0 h1. ; w0 := abs addr of param byte; 19468 43856 rs. w0 h1. ; save (cur instruction ptr); 19469 43858 bl w0 (0) ; w0 := param (cur instr ptr); 19470 43860 jl x3 ; return; 19471 43862 19471 43862 19471 43862 ; procedure call table program 19472 43862 ; 19473 43862 ; call: al w3 <abs address of start of program> 19474 43862 ; jl. n20. 19475 43862 19475 43862 n20: rl. w1 h1. ; call table program: 19476 43864 rs. w1 (h2.) ; stack (cur instr ptr); 19477 43866 rl. w1 h2. ; 19478 43868 al w1 x1+2 ; increase (stack ptr); 19479 43870 g10: rs. w1 h2. ; 19480 43872 jl. g1. ; goto save abs instr ptr; 19481 43874 19481 43874 n33: am n5-n1 ; return to program and goto: 19482 43876 n31: am n1-n0 ; return to program and skip: 19483 43878 n30: al. w3 n0. ; return to program: 19484 43880 rl. w1 h2. ; 19485 43882 al w1 x1-2 ; decrease (stack ptr); 19486 43884 rs. w1 h2. ; 19487 43886 rl w1 x1 ; unstack (cur instr ptr); 19488 43888 rs. w1 h1. ; 19489 43890 jl x3 ; goto next or skip or goto-action; 19490 43892 19490 43892 19490 43892 ; subroutine call following program and return later to function 19491 43892 ; 19492 43892 ; call: jl. w3 n25. 19493 43892 19493 43892 n25: rl. w1 h2. ; call from function: 19494 43894 rs w3 x1 ; stack (return to function); 19495 43896 rl. w3 h1. ; 19496 43898 rs w3 x1+2 ; stack (cur instr ptr); 19497 43900 al w1 x1+4 ; increase (stack ptr); 19498 43902 al w3 x3+h0+h0 ; w3 := abs addr of second byte; 19499 43904 jl. g10. ; goto save stackptr and cur instr ptr; 19500 43906 19500 43906 n35: rl. w1 h2. ; return from program to function: 19501 43908 al w1 x1-4 ; 19502 43910 rs. w1 h2. ; decrease (stack ptr); 19503 43912 rl w3 x1+2 ; unstack (cur instr ptr); 19504 43914 rs. w3 h1. ; 19505 43916 jl (x1) ; return to unstack (function); 19506 43918 19506 43918 19506 43918 19506 43918 n50: ; base of interpretation addresses: 19507 43918 19507 43918 19507 43918 19507 43918 ; start interpretation 19508 43918 ; 19509 43918 ; the previous procfunc call is answerred and the next is awaited 19510 43918 ; the differrent pointers are initialized 19511 43918 19511 43918 j7: am 7-6 ; result 7: 19512 43920 j6: am 6-5 ; result 6: 19513 43922 j5: am 5-4 ; result 5: 19514 43924 j4: am 4-3 ; result 4: 19515 43926 j3: am 3-2 ; result 3: 19516 43928 j2: am 2-1 ; result 2: 19517 43930 j1: am 1-0 ; result 1: 19518 43932 j0: al w0 0 ; result 0: 19519 43934 rl. w1 d2. ; w1 := sender; 19520 43936 rs w0 x1+a28 ; w0.sender := result; 19521 43938 jl. w3 e1. ; set maincat; 19522 43940 jl. w3 e7. ; terminate update; 19523 43942 19523 43942 j10: jd 1<11+2 ; waiting instruction: 19524 43944 rl w1 b1 ; w1 := procfunc; 19525 43946 rl w1 x1+a15 ; sender := next (messq (procfunc) ) - a16; 19526 43948 al w1 x1-a16 ; 19527 43950 rs. w1 d2. ; save (sender); 19528 43952 19528 43952 rl w3 x1+a176 ; w3 := monitor call number; 19529 43954 ws. w3 h9. ; ( = word (ic.sender - 2) - jd 1<11+40 ) 19530 43956 19530 43956 ; w1 = sender 19531 43956 ; w3 = monitor call number 19532 43956 19532 43956 al. w2 h3. ; 19533 43958 rs. w2 h2. ; stack ptr := start of stack; 19534 43960 ls w3 -1 ; 19535 43962 wa. w3 h10. ; cur instruction ptr := start table (monitor call); 19536 43964 ba w3 x3 ; 19537 43966 jl. g1. ; goto next instruction; 19538 43968 h9: 40 ; first procfunc monitor call 19539 43970 h10: n49 ; start of table 19540 43972 19540 43972 e. ; 19541 43972 \f 19541 43972 19541 43972 m. 19541 43972 monprocfnc2 - monitor process functions, part 2 19542 43972 19542 43972 b.i30 w. 19543 43972 i0=82 04 23, i1=13 00 00 19544 43972 19544 43972 ; if newtime (i0,i1) > oldtime (a133,a134) then oldtime:=newtime; 19545 43972 c.i0-a133 19546 43972 c.i0-a133-1, a133=i0, a134=i1, z. 19547 43972 c.i1-a134-1, a134=i1, z. 19548 43972 z. 19549 43972 19549 43972 i10=i0, i20=i1 19550 43972 19550 43972 i15=i10/100000 , i10=i10-i15*100000 , i25=i20/100000 , i20=i20-i25*100000 19551 43972 i14=i10/10000 , i10=i10-i14*10000 , i24=i20/10000 , i20=i20-i24*10000 19552 43972 i13=i10/1000 , i10=i10-i13*1000 , i23=i20/1000 , i20=i20-i23*1000 19553 43972 i12=i10/100 , i10=i10-i12*100 , i22=i20/100 , i20=i20-i22*100 19554 43972 i11=i10/10 , i10=i10-i11*10 , i21=i20/10 , i20=i20-i21*10 19555 43972 19555 43972 i2: <: date :> 19556 43996 (:i15+48:)<16+(:i14+48:)<8+46 19557 43998 (:i13+48:)<16+(:i12+48:)<8+46 19558 44000 (:i11+48:)<16+(:i10+48:)<8+32 19559 44002 19559 44002 (:i25+48:)<16+(:i24+48:)<8+46 19560 44004 (:i23+48:)<16+(:i22+48:)<8+46 19561 44006 (:i21+48:)<16+(:i20+48:)<8+ 0 19562 44008 19562 44008 i3: al. w0 i2. ; write date: 19563 44010 rs w0 x2+0 ; first free:=start(text); 19564 44012 al w2 0 ; 19565 44014 jl x3 ; return to slang(status ok); 19566 44016 19566 44016 jl. i3. ; 19567 44018 e. 19568 44018 j. 19568 43972 date 82.04.23 13.00.00 19569 43972 19569 43972 19569 43972 ; btj 1977.06.07 19570 43972 19570 43972 19570 43972 ; check maincat 19571 43972 ; tests the existence of a main catalog 19572 43972 ; 19573 43972 ; call: m0, <no maincat addr> 19574 43972 ; exit: w2 = unchanged 19575 43972 ; error exits: goto-action 19576 43972 19576 43972 m0: ; check maincat: 19577 43972 rl w0 b25 ; 19578 43974 se w0 0 ; if maincat docaddr <> 0 then 19579 43976 jl. n1. ; skip 19580 43978 jl. n5. ; else goto next param; 19581 43980 19581 43980 19581 43980 19581 43980 ; check main catalog not on document 19582 43980 ; 19583 43980 ; call: m1 19584 43980 ; error exits: result 6, if maincat on document 19585 43980 19585 43980 m1: ; check maincat not on document: 19586 43980 rl. w0 d4. ; 19587 43982 se w0 (b25) ; if curdoc <> maincat docaddr then 19588 43984 jl. n0. ; next instruction; 19589 43986 jl. j6. ; goto result 6; 19590 43988 19590 43988 19590 43988 19590 43988 ; clear maincat 19591 43988 ; 19592 43988 ; call: m2 19593 43988 19593 43988 m2: ; clear maincat: 19594 43988 al w0 0 ; 19595 43990 rs w0 b25 ; maincat docaddr := 0; 19596 43992 jl. n0. ; next instruction; 19597 43994 19597 43994 19597 43994 ; if main-catalog entry then goto <addr> 19598 43994 ; 19599 43994 ; call: m3, <maincatalog entry addr> 19600 43994 ; error return: goto-action 1, if main catalog entry 19601 43994 19601 43994 m3: ; test maincat entry: 19602 43994 rl w2 b25 ; 19603 43996 se. w2 (d4.) ; if curdoc <> maincat docaddr then 19604 43998 jl. n1. ; skip; 19605 44000 19605 44000 al. w2 d9. ; w2 := maincat pseudo chain; 19606 44002 19606 44002 jl. w3 e41. ; compare names (name.work, name.pseudochain); 19607 44004 jl. n1. ;+2: not same: skip; 19608 44006 19608 44006 bl. w0 v4. ; if first slice.work <> 19609 44008 bs w0 x2+f54 ; first slice.pseudochain then 19610 44010 se w0 0 ; 19611 44012 jl. n1. ; skip; 19612 44014 19612 44014 dl. w1 v2. ; if base.work <> 19613 44016 sn w0 (x2+f1-f0) ; 19614 44018 se w1 (x2+f2-f0) ; base.pseudochain then 19615 44020 jl. n1. ; skip; 19616 44022 19616 44022 jl. n5. ; goto <main catalog entry>; 19617 44024 19617 44024 19617 44024 19617 44024 ; the two following routines terminate the use of the current catalog, 19618 44024 ; and selects the new catalog. 19619 44024 ; the catalog may either be an auxilliary catalog or the main catalog. 19620 44024 19620 44024 ; set auxcat 19621 44024 ; 19622 44024 ; call: m4 19623 44024 ; error return: result 2, in case of catalog io-error 19624 44024 19624 44024 m4: ; set auxcat: 19625 44024 jl. e0. ; set auxcat and return; 19626 44026 19626 44026 ; set maincat 19627 44026 ; 19628 44026 ; call: m5 19629 44026 ; error return: result 2, in case of catalog io-error 19630 44026 19630 44026 m5: ; set maincat: 19631 44026 jl. e1. ; set maincat and return; 19632 44028 19632 44028 19632 44028 19632 44028 ; dump chaintable 19633 44028 ; 19634 44028 ; the chaintable of curdoc is written back on the device 19635 44028 ; 19636 44028 ; call: m6 19637 44028 ; error return: result 2, in case of io-error 19638 44028 19638 44028 m6: ; dump chaintable: 19639 44028 jl. e2. ; dump chaintable and return; 19640 44030 19640 44030 19640 44030 19640 44030 19640 44030 19640 44030 19640 44030 ; check function mask 19641 44030 ; tests that the internal process is allowed to execute the current 19642 44030 ; monitor call 19643 44030 ; 19644 44030 ; call: w1 = sender 19645 44030 ; m8, <function bit> 19646 44030 ; error exits: result 1, if function bit is not in function mask.internal 19647 44030 19647 44030 m8: ; check function mask: 19648 44030 jl. w3 n10. ; w0 := bit := next param; 19649 44032 bl w3 x1+a22 ; mask := function mask.sender; 19650 44034 so w3 (0) ; if bit not contained in mask then 19651 44036 jl. j1. ; goto result 1; 19652 44038 jl. n0. ; next instruction; 19653 44040 19653 44040 19653 44040 19653 44040 ; check privileges 19654 44040 ; 19655 44040 ; checks that the sender is allowed to manipulate with the catalog-system 19656 44040 ; on the current bs-device: 19657 44040 ; 1. the sender must be user of the device 19658 44040 ; 19659 44040 ; call: w2 = chain 19660 44040 ; m9 19661 44040 ; error exits: result 4, if not user 19662 44040 19662 44040 m9: ; check privs: 19663 44040 rl. w1 d2. ; w1 := sender; 19664 44042 rl w3 (x2+f62) ; w3 := bs-process (= nametable.nametab addr.chain) 19665 44044 rl w0 x3+a53 ; w0 := users.proc; 19666 44046 so w0 (x1+a14) ; if sender is not user of proc then 19667 44048 jl. j4. ; goto result 4; 19668 44050 jl. n0. ; next instruction; 19669 44052 19669 44052 19669 44052 19669 44052 ; search best entry 19670 44052 ; 19671 44052 ; call: m10, <not found addr> 19672 44052 ; error exits: result 2, if catalog io-error 19673 44052 ; result 6, if name format illegal 19674 44052 ; goto-action 1, if not found 19675 44052 19675 44052 m10: ; search best entry: 19676 44052 jl. w3 e46. ; search best entry in catalog; 19677 44054 jl. n5. ;+2: not found: goto 19678 44056 jl. n1. ; skip 19679 44058 19679 44058 19679 44058 19679 44058 ; search best entry and test modification allowed 19680 44058 ; 19681 44058 ; the best catalog entry is found. if an areaprocess exists for that 19682 44058 ; entry, it will be tested that no other process is user (or reserver) 19683 44058 ; as specified in parameter 19684 44058 ; 19685 44058 ; call: m11, <no user/no reserver> 19686 44058 ; (no user = a53, no reserver = a52) 19687 44058 ; error exits: result 2, if catalog io-error 19688 44058 ; result 3, if not found 19689 44058 ; result 4, if base.entry is outside maxbase.sender 19690 44058 ; result 5, if modification not allowed 19691 44058 ; result 6, if nameformat illegal 19692 44058 19692 44058 m11: ; search best entry and test modif allowed: 19693 44058 jl. w3 e46. ; search best entry; 19694 44060 jl. j3. ;+2: not found: goto result 3; 19695 44062 19695 44062 ; w0w1 := base.entry 19696 44062 rl. w3 d2. ; 19697 44064 dl w3 x3+a44 ; w2w3 := maxbase.sender; 19698 44066 sl w0 x2 ; if base.entry outside maxbase.sender then 19699 44068 sl w1 x3+1 ; 19700 44070 jl. j4. ; goto result 4; 19701 44072 19701 44072 al w0 0 ; cur proc nametable addr := 0; 19702 44074 rs. w0 d11. ; (i.e. no areaprocess found) 19703 44076 19703 44076 jl. w3 e43. ; for all area processes with same name do 19704 44078 b5 ; 19705 44080 b6 ; 19706 44082 jl. n1. ;+6: no more: skip 19707 44084 19707 44084 ; w0w1 = base.proc, w2 = nametable address of area process, w3 = continue 19708 44084 sn. w0 (v1.) ; if base.proc <> base.work then 19709 44086 se. w1 (v2.) ; 19710 44088 jl x3 ; continue search; 19711 44090 19711 44090 ; an area process is found with exact the same base as base.work 19712 44090 rs. w2 d11. ; cur proc nametable addr := nametable addr; 19713 44092 19713 44092 jl. w3 n10. ; w0 := rel addr in proc descr to test; 19714 44094 wa w0 x2 ; 19715 44096 rl w0 (0) ; w0 := reserver (or users) of proc; 19716 44098 19716 44098 rl. w1 d2. ; w1 := sender; 19717 44100 lo w0 x1+a14 ; 19718 44102 ws w0 x1+a14 ; if reserver- (or user-word) contains no other 19719 44104 sn w0 0 ; bits than id-bit.sender then 19720 44106 jl. n0. ; next instruction; (notice: param is skipped) 19721 44108 19721 44108 ; the area process was protected by another internal process 19722 44108 jl. j5. ; goto result 5; 19723 44110 19723 44110 19723 44110 19723 44110 ; test name format 19724 44110 ; 19725 44110 ; the format of name.work is tested 19726 44110 ; 19727 44110 ; call: m13 19728 44110 ; error exits: result 6, if name format illegal 19729 44110 19729 44110 m13: ; test name format: 19730 44110 jl. e24. ; goto test name format; 19731 44112 e24 = k-2 ; stepping stone 19732 44112 19732 44112 19732 44112 19732 44112 ; compute namekey 19733 44112 ; 19734 44112 ; namekey.work is computed and set, according to name.work 19735 44112 ; 19736 44112 ; call: m14 19737 44112 19737 44112 m14: ; compute namekey: 19738 44112 jl. e3. ; compute namekey and return; 19739 44114 19739 44114 19739 44114 19739 44114 ; test new system name (maybe wrk-name) 19740 44114 ; 19741 44114 ; the chaintables and the whole nametable and the current catalog 19742 44114 ; are scanned in order to check, that (base.work,name.work) does 19743 44114 ; not coincide with the already existing names. 19744 44114 ; 19745 44114 ; (the reason for searching the chaintables too is, that a name, 19746 44114 ; once reserved as a document-name, is protected against misuse 19747 44114 ; in case of intervention on a disc (in which case the process-name 19748 44114 ; is cleared). the name may only be reused by exactly the same 19749 44114 ; process or it may be released by means of ..delete bs.. etc. 19750 44114 ; this means that procfunc does not have to check with the catalog 19751 44114 ; when ..create peripheral process.. is used to restore the name 19752 44114 ; of the disc-process ) 19753 44114 ; 19754 44114 ; if name(0).work = 0 then a wrk-name is generated, which is 19755 44114 ; completely unique (i.e. independant of base), and the wrk-name 19756 44114 ; is moved to name.work. 19757 44114 ; 19758 44114 ; call: m15, <overlap addr>, <exact addr> 19759 44114 ; error exits: result 2, if catalog io-error 19760 44114 ; result 6, if nameformat illegal 19761 44114 ; goto-action 1, if overlap 19762 44114 ; goto-action 2, if exact (base, name) exists 19763 44114 19763 44114 ; generate wrk-name 19764 44114 ; 19765 44114 ; a wrk-name is generated, which is completely unique (i.e. 19766 44114 ; independant of base), 19767 44114 ; and the wrk-name is moved to name.work 19768 44114 ; 19769 44114 ; call: m16, <irrell>, <irrell> 19770 44114 ; error exits: result 2, if catalog error 19771 44114 19771 44114 ; test new system name (wrk-name not allowed) 19772 44114 ; 19773 44114 ; function as ..test new system name, wrkname allowed.. except that 19774 44114 ; wrk-name is not allowed 19775 44114 ; 19776 44114 ; call: m17, <overlap addr>, <exact addr> 19777 44114 ; error exits: as test new system name 19778 44114 19778 44114 b. g30 w. 19779 44114 19779 44114 m15: ; test new system name, wrk-name allowed: 19780 44114 rl. w0 v5. ; create wrkname := name(0).work = 0; 19781 44116 sn w0 0 ; 19782 44118 m16: ; generate wrk-name: 19783 44118 am -1 ; create wrkname := true; 19784 44120 m17: ; test new system name , wrk-name not allowed: 19785 44120 al w0 0 ; create wrkname := false; 19786 44122 rs. w0 d17. ; 19787 44124 ; d17 = 0 : create wrkname == false 19788 44124 ; d17 = -1 : create wrkname == true 19789 44124 19789 44124 se w0 -1 ; if not create wrk-name then 19790 44126 am e24-e23; test name format 19791 44128 ; else 19792 44128 g0: ; next wrk-name: 19793 44128 jl. w3 e23. ; create next wrkname; 19794 44130 ; (i.e. maybe generate the next wrk-name) 19795 44130 19795 44130 jl. w3 e45. ; find chain (name.work); 19796 44132 v5 ; 19797 44134 jl. g1. ;+4: not found: goto test in nametable; 19798 44136 ;+6: found: 19799 44136 dl w1 b45 ; base := catalog interval; 19800 44138 jl. w3 g20. ; test overlap; 19801 44140 19801 44140 g1: ; test in nametable: 19802 44140 jl. w3 e43. ; for all procs in nametable do 19803 44142 b3 ; 19804 44144 b7 ; 19805 44146 jl. g8. ;+6: no more: goto test main catalog; 19806 44148 jl. g20. ; goto test overlap and continue; 19807 44150 19807 44150 g8: ; test main catalog: 19808 44150 rl w0 b25 ; 19809 44152 se w0 0 ; if main catalog exists then 19810 44154 jl. g10. ; goto test in current catalog; 19811 44156 jl. n2. ; skip 2; 19812 44158 19812 44158 19812 44158 19812 44158 ; test new catalog name 19813 44158 ; 19814 44158 ; the current catalog is scanned in order to test that 19815 44158 ; (base.work, name.work) do not coincide with any entries 19816 44158 ; 19817 44158 ; call: m18, <overlap addr>, <exact addr> 19818 44158 ; error exits: as ..test new system name.. 19819 44158 ; notice: cur entry position is defined at <exact> return 19820 44158 19820 44158 m18: ; test new catalog name: 19821 44158 jl. w3 e24. ; test format; 19822 44160 al w0 0 ; create wrkname := false; 19823 44162 rs. w0 d17. ; 19824 44164 g10: ; test in current catalog: 19825 44164 jl. w3 e42. ; for all named entries in catalog do 19826 44166 jl. n2. ;+2: no more: skip 2 (notice params not skipped yet) 19827 44168 19827 44168 ; subprocedure test overlap 19828 44168 ; if wrkname generated then goto test in nametable 19829 44168 ; if overlap then goto first param addr 19830 44168 ; if base = base.work then goto second param addr 19831 44168 ; 19832 44168 ; entry: w0w1 = base.entry(or proc), (maybe w2 = entry), w3 = link 19833 44168 ; exit: all regs unchanged 19834 44168 19834 44168 g20: ; test overlap: 19835 44168 sz. w3 (d17.) ; if create wrkname then 19836 44170 jl. g0. ; goto next wrk-name; 19837 44172 19837 44172 sh. w0 (v1.) ; if lower base > lower.work then 19838 44174 jl. g21. ; begin 19839 44176 sh. w0 (v2.) ; if lower base > upper.work 19840 44178 sh. w1 (v2.) ; or upper base <= upper.work then 19841 44180 jl x3 ; return; i.e. inside base.work or above 19842 44182 jl. n5. ; goto overlap-addr; i.e embraces upper.work 19843 44184 g21: ; end; 19844 44184 sl. w1 (v2.) ; if upper base < upper.work then 19845 44186 jl. g22. ; begin 19846 44188 sl. w1 (v1.) ; if upper base < lower.work 19847 44190 sl. w0 (v1.) ; or lower base >= lower.work then 19848 44192 jl x3 ; return; i.e. inside base.work or below 19849 44194 jl. n5. ; goto overlap-addr; i.e. embraces lower.work 19850 44196 g22: ; end; 19851 44196 sn. w0 (v1.) ; if base <> base.work then 19852 44198 se. w1 (v2.) ; 19853 44200 jl x3 ; return; i.e. contains base.work 19854 44202 jl. w3 e48. ; save position; 19855 44204 jl. n6. ; goto exact-addr; 19856 44206 19856 44206 d17: 0 ; create wrk-name: 0 == false, all ones == true 19857 44208 19857 44208 e. ; 19858 44208 19858 44208 19858 44208 ; test chain error 19859 44208 ; 19860 44208 ; tests that the previous call of ..copy chain.. did not 19861 44208 ; give any overlap-errors etc 19862 44208 ; 19863 44208 ; call: m19 19864 44208 ; error exits: result 5, if any errors 19865 44208 19865 44208 b. g20, h10 w. 19866 44208 19866 44208 m19: ; test chain error: 19867 44208 rl. w0 h3. ; 19868 44210 sn w0 0 ; if any errors = 0 then 19869 44212 jl. n0. ; next instruction; 19870 44214 jl. j5. ; goto result 5; 19871 44216 19871 44216 19871 44216 19871 44216 ; copy chaintable chain 19872 44216 ; 19873 44216 ; call: m20 19874 44216 ; error exits: result 5, if chain is too short 19875 44216 ; return: w2 = slices 19876 44216 19876 44216 m20: ; copy chaintable chain: 19877 44216 bz. w1 v26. ; w1 := last slice number; 19878 44218 al w1 x1+f0+1+511; bytes := last slice + 1 + size of chainhead + round 19879 44220 ls w1 -9 ; w1 := number of segments used for chaintable; 19880 44222 19880 44222 al. w3 v27. ; w3 := addr of first slice information; 19881 44224 19881 44224 jl. w2 g10. ; copy chain(w1, w3); 19882 44226 jl. n0. ;+2: chain ok: next instruction 19883 44228 jl. n0. ;+4: chain too long: next instruction 19884 44230 jl. j5. ;+6: chain too short: result 5 19885 44232 19885 44232 19885 44232 19885 44232 ; copy chain and cut down 19886 44232 ; 19887 44232 ; call: m21 19888 44232 ; return: w2 = slices 19889 44232 19889 44232 m21: ; copy chain and cut down: 19890 44232 rl. w1 v7. ; w1 := size.work; 19891 44234 al. w3 v4. ; w3 := addr of first slice information; 19892 44236 19892 44236 jl. w2 g10. ; copy chain; 19893 44238 jl. n0. ;+2: chain ok: next instruction 19894 44240 jl. n0. ;+4: chain too long: next instruction 19895 44242 ;+6: chain too short: 19896 44242 19896 44242 ; w0 = 0 19897 44242 ; w1 = remaining number of slices without chains 19898 44242 ; w2 = irrellevant 19899 44242 ; w3 = irrellevant 19900 44242 19900 44242 rl. w3 d4. ; w3 := curdoc; 19901 44244 wm w1 x3+f64 ; segments := - slices * slicelength 19902 44246 ac w1 x1 ; 19903 44248 wa. w1 v7. ; + size.work; 19904 44250 wd w1 x3+f64 ; slices := segments / slicelength (rounded); 19905 44252 se w0 0 ; 19906 44254 al w1 x1+1 ; 19907 44256 al w2 x1 ; w2 := slices; 19908 44258 wm w1 x3+f64 ; 19909 44260 rs. w1 v7. ; size.work := slices * slicelength; 19910 44262 19910 44262 jl. n0. ; next instruction; 19911 44264 19911 44264 19911 44264 19911 44264 ; subprocedure copy chain 19912 44264 ; 19913 44264 ; copies a chain from senders area into the curdoc chaintable. 19914 44264 ; all the new chain-elements in curdoc chaintable must be in 19915 44264 ; state = free. 19916 44264 ; the chain is copied until: 19917 44264 ; 1. a chain addresses outside the chaintable 19918 44264 ; or 2. the areasize is reached 19919 44264 ; or 3. the chain is terminated 19920 44264 ; whichever occurs first. 19921 44264 ; all new chain-elements are counted (unless already used). 19922 44264 ; in case of chain overlap the copying will proceed, but will not 19923 44264 ; destroy the chains already copied. 19924 44264 ; 19925 44264 ; if the areasize is negative, it is a filedecriptor. in this case 19926 44264 ; no chain is copied (of course), but first slice.work is set to 19927 44264 ; doc-ident. 19928 44264 ; 19929 44264 ; call: w1 = areasize, w2 = link, w3 = addr of first slice information 19930 44264 ; return: link+0: chain matches areasize : w2 = slices 19931 44264 ; link+2: chain too long : w2 = slices used 19932 44264 ; link+4: chain too short : w0 = 0, w1 = slices not used 19933 44264 19933 44264 g10: ; copy chain: 19934 44264 rs. w2 h0. ; save(return); 19935 44266 19935 44266 al w0 0 ; (w0 := 0;) 19936 44268 rs. w0 h3. ; any errors := false; 19937 44270 19937 44270 sl w1 1 ; if areasize > 0 then 19938 44272 jl. g12. ; goto area; 19939 44274 19939 44274 ; the areasize is either zero or negative, prepare first slice := 0 19940 44274 al w2 0 ; first slice := 0; 19941 44276 hs w2 x3 ; (w2 = number of slices := 0;) 19942 44278 sn w1 0 ; if areasize = 0 then 19943 44280 jl. (h0.) ; next instruction; 19944 44282 jl. m91. ; goto compute docnumber; 19945 44284 19945 44284 g12: ; area: 19946 44284 jl. w2 e62. ; w2 := abs addr (w3.sender); 19947 44286 rs. w2 h1. ; sender chain := abs addr of save w3.sender 19948 44288 19948 44288 rl. w2 d4. ; w2 := curdoc; 19949 44290 ; w0 = 0 19950 44290 wd w1 x2+f64 ; 19951 44292 se w0 0 ; w1 := slices to use := areasize / slicelength; 19952 44294 ; (rounded) 19953 44294 al w1 x1+1 ; 19954 44296 rs. w1 h2. ; 19955 44298 19955 44298 bz w2 x2+f66 ; w2 := last slicenumber of chaintable; 19956 44300 bz w3 x3 ; w3 := first slice number; 19957 44302 19957 44302 g13: ; next slice: 19958 44302 ; w1 = remaining slices to copy 19959 44302 ; w2 = last slicenumber of slicetable 19960 44302 ; w3 = current slicenumber 19961 44302 sl w3 0 ; if slicenumber outside 19962 44304 sl w3 x2+1 ; chaintable then 19963 44306 jl. g16. ; goto chain outside limits; 19964 44308 19964 44308 am. (d4.) ; if corresponding slice in chaintable 19965 44310 bl w0 x3 ; is not free then 19966 44312 sn w0 -2048 ; 19967 44314 jl. g14. ; begin 19968 44316 rs. w2 h3. ; any errors := true; 19969 44318 am. (h1.) ; w0 := slicelink; 19970 44320 bl w0 x3+f0 ; 19971 44322 jl. g15. ; end 19972 44324 g14: ; else 19973 44324 am. (h1.) ; 19974 44326 bl w0 x3+f0 ; move chain element from user area 19975 44328 am. (d4.) ; to curdoc chain; 19976 44330 hs w0 x3 ; 19977 44332 g15: ; 19978 44332 wa w3 0 ; slicenumber := next(slicenumber); 19979 44334 al w1 x1-1 ; decrease(remaining slices); 19980 44336 sn w1 0 ; if remaining slices = 0 then 19981 44338 jl. g17. ; goto chain ok or too long; 19982 44340 se w0 0 ; if not end of chain then 19983 44342 jl. g13. ; goto next slice; 19984 44344 ; the chain was too short 19985 44344 am. (h0.) ; 19986 44346 jl +4 ; return short-exit; (independant of errors) 19987 44348 19987 44348 g16: ; chain outside limits: 19988 44348 rs. w3 h3. ; any errors := true; 19989 44350 al w1 0 ; 19990 44352 19990 44352 g17: ; chain ok or too long: 19991 44352 ; w0 = contents of last slice 19992 44352 ; w1 = 0 19993 44352 ; w2 = irrellevant 19994 44352 ; w3 = next slicenumber 19995 44352 rl. w2 h2. ; w2 := slices used; 19996 44354 se w0 0 ; if end of chain 19997 44356 se. w1 (h3.) ; or any errors then 19998 44358 jl. (h0.) ; then return ok; 19999 44360 19999 44360 ws w3 0 ; w3 := last slicenumber; 20000 44362 am. (d4.) ; 20001 44364 hs w1 x3 ; slicelink(last slicenumber).curdoc := end of chain 20002 44366 am. (h0.) ; 20003 44368 jl +2 ; return chain too long; 20004 44370 20004 44370 h0: 0 ; saved return 20005 44372 h1: 0 ; saved chainhead address in sender area 20006 44374 h2: 0 ; slices used 20007 44376 h3: 0 ; any errors ( 0 == false, else true ) 20008 44378 20008 44378 e. ; 20009 44378 20009 44378 20009 44378 20009 44378 ; compute slices to claim 20010 44378 ; 20011 44378 ; the current slice-chain of entry.work is scanned, thus counting the 20012 44378 ; number of slices it used to occupy. 20013 44378 ; this number is compared to the new size.work: 20014 44378 ; 20015 44378 ; if new number of slices < counted number then 20016 44378 ; save address of last slicelink to use 20017 44378 ; 20018 44378 ; if new number of slices > counted number then 20019 44378 ; save address of last used slicelink 20020 44378 ; 20021 44378 ; call: m22, <compute new slices> 20022 44378 ; return: w2 = slices 20023 44378 ; variables are defined for later call of: adjust chain 20024 44378 20024 44378 b. g20, h10 w. 20025 44378 20025 44378 m22: ; compute slices to claim: 20026 44378 jl. w3 n10. ; w0 := next param; 20027 44380 20027 44380 rl. w2 v7. ; 20028 44382 sh w2 -1 ; if size.work < 0 then 20029 44384 jl. g4. ; goto non-area; 20030 44386 20030 44386 so w0 2.10 ; if not compute new slices then 20031 44388 al w2 0 ; size := 0; 20032 44390 20032 44390 rl. w3 d4. ; w3 := curdoc; 20033 44392 al w1 0 ; 20034 44394 wd w2 x3+f64 ; w2 := slices to use := 20035 44396 se w1 0 ; size / slicelength (rounded); 20036 44398 al w2 x2+1 ; 20037 44400 20037 44400 al. w0 v4. ; (prepare new area or no slices) 20038 44402 bz. w1 v4. ; w1 := first slice.work; 20039 44404 wa w1 6 ; w1 := abs addr of first slice; 20040 44406 rs. w1 h4. ; minslice := first slice; 20041 44408 sn w1 x3 ; if old size = 0 then 20042 44410 jl. g2. ; goto after count; 20043 44412 ; notice: an area may not start in slice 0 20044 44412 20044 44412 20044 44412 g1: ; count next: 20045 44412 ; w0 = abs addr of last slice link (either first slice.work or curr slice) 20046 44412 ; w1 = abs addr of next slice link 20047 44412 ; w2 = slices to use 20048 44412 al w2 x2-1 ; decrease(remaining slices to use); 20049 44414 sn w2 -1 ; if area must be cut down then 20050 44416 ds. w1 h1. ; save(curr slice addr, next slice addr); 20051 44418 20051 44418 al w0 x1 ; curr slice := next slice; 20052 44420 ba w1 x1 ; next slice := next(next slice); 20053 44422 20053 44422 sh. w1 (h4.) ; if next slice <= minslice then 20054 44424 rs. w1 h4. ; minslice := next slice; 20055 44426 20055 44426 se w0 x1 ; if current slice is not the last one then 20056 44428 jl. g1. ; goto count next; 20057 44430 20057 44430 g2: ; after count: 20058 44430 20058 44430 ; w0 = abs addr of current slice 20059 44430 ; w1 = abs addr of next slice (if area exhausted then curr=next) 20060 44430 ; w2 = slice change 20061 44430 20061 44430 rs. w2 h2. ; save(slice change); 20062 44432 sl w2 0 ; if new size = old size or area must be extended 20063 44434 ds. w1 h1. ; then save(current slice, next slice); 20064 44436 20064 44436 jl. n0. ; next instruction; 20065 44438 20065 44438 g4: ; non-area: 20066 44438 al w2 0 ; slice change := 0; 20067 44440 jl. g2. ; goto after count; 20068 44442 20068 44442 h0: 0 ; abs addr of current slice 20069 44444 h1: 0 ; abs addr of next slice 20070 44446 h2: 0 ; slice change 20071 44448 h3: 0 ; abs address of last slice in chaintable 20072 44450 h4: 0 ; abs addr of min slice 20073 44452 20073 44452 20073 44452 20073 44452 ; adjust chain to size 20074 44452 ; 20075 44452 ; the chain of entry.work is extended or cut down, as 20076 44452 ; decided by the previous function 20077 44452 ; 20078 44452 ; if the area must be extended, it will preferably be extended 20079 44452 ; with slices adjacent to the last slice, otherwise preferably 20080 44452 ; as a contiguous area. 20081 44452 ; 20082 44452 ; call: (m22 must have been called prior to this function) 20083 44452 ; m23 20084 44452 20084 44452 m23: ; adjust chain: 20085 44452 rl. w3 d4. ; w3 := curdoc; 20086 44454 bz w0 x3+f66 ; last slice := last slice number.curdoc; 20087 44456 wa w0 6 ; abs last slice addr := last slice + curdoc; 20088 44458 rs. w0 h3. ; 20089 44460 20089 44460 dl. w2 h2. ; w1 := abs addr of next slice; 20090 44462 ; w2 := remaining := slice change; 20091 44462 sn w2 0 ; if slice change = 0 then 20092 44464 jl. n0. ; next instruction; 20093 44466 20093 44466 g5: ; next portion: 20094 44466 sl w2 1 ; if remaining >= 1 then 20095 44468 jl. g8. ; goto extend area; 20096 44470 20096 44470 ; chain is now ok or too long 20097 44470 ; w1 = abs addr of next slice, i.e. first slice to release 20098 44470 ; w2 = remaining 20099 44470 ; h0 = abs addr of last slice link, i.e. end of chain 20100 44470 20100 44470 sn w2 0 ; if remaining = 0 then 20101 44472 jl. g7. ; goto set end of chain; 20102 44474 20102 44474 ; the old chain was longer than is has to be now, so release the 20103 44474 ; superflouos chain-elements 20104 44474 al w0 -2048 ; w0 := free element; 20105 44476 g6: al w3 x1 ; 20106 44478 ba w1 x1 ; release rest of chain 20107 44480 hs w0 x3 ; 20108 44482 se w1 x3 ; until end of chain; 20109 44484 jl. g6. ; 20110 44486 20110 44486 g7: ; set end of chain: 20111 44486 al w0 0 ; 20112 44488 hs. w0 (h0.) ; last link := end of chain; 20113 44490 jl. n0. ; next instruction; 20114 44492 20114 44492 g8: ; extend area: 20115 44492 20115 44492 ; the area was too short 20116 44492 ; try to extend the area with adjacent slices 20117 44492 ; w1 = abs addr of last used slice 20118 44492 ; w2 = remaining 20119 44492 20119 44492 sn. w1 (d4.) ; if old size = 0 then 20120 44494 jl. g9. ; goto new area; 20121 44496 20121 44496 sn. w1 (h3.) ; if abs addr of last used slice = 20122 44498 jl. g15. ; addr of last slice in chaintable then 20123 44500 ; goto get a slice; 20124 44500 bl w0 x1+1 ; 20125 44502 se w0 -2048 ; if adjacent slice is occupied then 20126 44504 jl. g15. ; goto get a slice; 20127 44506 20127 44506 ; the slice was free and may therefore be used for extending the area 20128 44506 al w0 1 ; slice link(last used slice) := 1; 20129 44508 hs w0 x1 ; 20130 44510 al w1 x1+1 ; increase(addr of last used slice); 20131 44512 g17: ; occupy byte: 20132 44512 ; w1 = new slice 20133 44512 ; w2 = remaining 20134 44512 al w0 0 ; 20135 44514 hs w0 x1 ; slicechain (new slice) := 0; i.e. end of chain; 20136 44516 rs. w1 h4. ; min slice := new slice; 20137 44518 rs. w1 h0. ; addr of curr slice := addr of last used slice; 20138 44520 al w2 x2-1 ; decrease(remaining); 20139 44522 jl. g5. ; goto next portion; 20140 44524 ; notice that end of chain will be set later 20141 44524 20141 44524 20141 44524 g9: ; new area: 20142 44524 ; try to find a contigouos hole that fits the remaining number 20143 44524 ; of slices 20144 44524 20144 44524 rl. w1 d4. ; slice := first slice of chaintable; 20145 44526 ; notice: the first slice of chaintable will never be allocated 20146 44526 20146 44526 g10: ; get start of free area: 20147 44526 al w2 x1+1 ; w2 := free := next slice; 20148 44528 al w3 0 ; w3 := free size := 0; 20149 44530 g11: ; test next slice: 20150 44530 sl. w1 (h3.) ; if slice = last slice of chaintable then 20151 44532 jl. g13. ; goto take first free; 20152 44534 al w1 x1+1 ; increase(slice); 20153 44536 bl w0 x1 ; 20154 44538 se w0 -2048 ; if slice <> free then 20155 44540 jl. g10. ; goto get start of free area; 20156 44542 al w3 x3+1 ; increase(free size); 20157 44544 se. w3 (h2.) ; if free size < remaining then 20158 44546 jl. g11. ; goto test next slice; 20159 44548 20159 44548 ; a hole of the sufficient size is found 20160 44548 20160 44548 g12: ; connect slice to area: 20161 44548 ; w2 = abs addr of start of new slice 20162 44548 ; h0 = abs addr of last slice link (maybe = first slice.work) 20163 44548 ; h1 = abs addr of previous slice (maybe = chaintable start) 20164 44548 al w1 x2 ; curr slice := new slice; 20165 44550 ws. w2 h1. ; slicelink := addr of new slice - addr of previous; 20166 44552 hs. w2 (h0.) ; link(last slice) := slicelink; 20167 44554 rl. w2 h2. ; remaining := remaining - 1; 20168 44556 jl. g17. ; goto occupy byte; 20169 44558 20169 44558 g15: ; get a slice: 20170 44558 ; w1 = abs addr of last used slice 20171 44558 ; w2 = remaining 20172 44558 20172 44558 ds. w2 h2. ; save (last used, remaining); 20173 44560 20173 44560 ; it was not possible to get a contigouos area. 20174 44560 ; therefor just take the first free slice, and try once more 20175 44560 ; w1 = abs addr of last slice in chaintable 20176 44560 g13: ; take first free: 20177 44560 rl. w2 h4. ; free := minslice; 20178 44562 g14: ; test next: 20179 44562 sl. w2 (h3.) ; if free is the last slice of chaintable then 20180 44564 jl. g16. ; goto test from first of chaintable; 20181 44566 al w2 x2+1 ; increase (free); 20182 44568 bl w0 x2 ; 20183 44570 se w0 -2048 ; if slice(free) is not free then 20184 44572 jl. g14. ; goto test next; 20185 44574 jl. g12. ; goto connect slice to area; 20186 44576 20186 44576 ; it was not possible to find a slice between minslice and 20187 44576 ; last of chaintable. 20188 44576 ; now try between first and last of chaintable 20189 44576 g16: ; test from first of chaintable: 20190 44576 rl. w2 d4. ; 20191 44578 rx. w2 h4. ; minslice := first of chaintable; 20192 44580 se. w2 (h4.) ; if not already tried from first of chaintable then 20193 44582 jl. g13. ; goto take first free; 20194 44584 20194 44584 ; it was not even possible to find a single slice in the chaintable 20195 44584 jl. j7. ; alarm; 20196 44586 20196 44586 20196 44586 20196 44586 ; if area extended then <function> 20197 44586 ; 20198 44586 ; call: (m23 must have been called prior to this function) 20199 44586 ; m24, <instruction> 20200 44586 ; error return: skip action, if area was not extended 20201 44586 20201 44586 m24: ; if area extended then: 20202 44586 rl. w0 h2. ; w0 := slice change; 20203 44588 sh w0 0 ; if slice change <= 0 then 20204 44590 jl. n1. ; skip 20205 44592 jl. n0. ; else next instruction; 20206 44594 20206 44594 e. ; 20207 44594 20207 44594 20207 44594 ; description of current entry 20208 44594 0 ;-2 cur entry segment number 20209 44596 d3: 0 ; cur entry address ( in catalog) 20210 44598 d29=d3-2 20211 44598 20211 44598 20211 44598 ; record work: 20212 44598 ; (format as a catalog entry) 20213 44598 20213 44598 d1: 0, r.f0>1 ; work 20214 44632 d30: 0, r.4 ; stat area.work 20215 44640 20215 44640 v1 = d1 + f1 ; 20216 44640 v2 = d1 + f2 ; 20217 44640 v3 = d1 + f3 ; 20218 44640 v4 = d1 + f4 ; 20219 44640 v5 = d1 + f5 ; 20220 44640 v6 = d1 + f6 ; 20221 44640 v7 = d1 + f7 ; 20222 44640 v11= d1 + f11 ; 20223 44640 v12= d1 + f12 ; 20224 44640 v8= d1 + f13 ; 20225 44640 v13= d1 + f5 + 2 ; 20226 44640 v14= d1 + f5 + 6 ; 20227 44640 v15= d1 + f5 + 7 ; 20228 44640 v26= d1 + f66 + f0 ; 20229 44640 v27= d1 + f67 + f0 ; 20230 44640 v30= d1 + f11 + 2 ; 20231 44640 v31= d1 + f11 + 6 ; 20232 44640 v32= d1 + f12 + 2 ; 20233 44640 20233 44640 20233 44640 20233 44640 ; common variables: 20234 44640 d16: 0, r.8 ; answer area 20235 44656 c. 4 * (:a110+1:)+d16.-1; and 20236 44656 0, r. 2*(:a110+1:)+d16.>1; claim change array (set bs claims) 20237 44656 z. ; 20238 44656 d4: 0 ; curdoc: address of current document (chaintable) 20239 44658 d5: d9 ; maincat pseudochain 20240 44660 20240 44660 20240 44660 ; stepping stones: 20241 44660 jl. e5. , e5 = k-2 20242 44662 jl. e7. , e7 = k-2 20243 44664 jl. e8. , e8 = k-2 20244 44666 jl. e9. , e9 = k-2 20245 44668 jl. e10. , e10 = k-2 20246 44670 jl. e14. , e14 = k-2 20247 44672 jl. e15. , e15 = k-2 20248 44674 jl. e25. , e25 = k-2 20249 44676 20249 44676 20249 44676 20249 44676 ; the functions m25-m30 all have a common 20250 44676 ; call-sequence and error-return actions: 20251 44676 ; 20252 44676 ; call: w2 = slices 20253 44676 ; m<number>, <claims exceeded addr> 20254 44676 ; error return: goto-action 1, if claims exceeded 20255 44676 ; the functions m260 and m280 are used to adjust maincat entry claims in case 20256 44676 ; of insert entry result 3. 20257 44676 ; they will set w2=slices=0. 20258 44676 20258 44676 b. g20, h10 w. 20259 44676 20259 44676 h0: 0 ; entry-change 20260 44678 h1: 0 ; slice-change 20261 44680 h2: 0 ; maincat claim addr 20262 44682 h3: 0 ; auxcat claim addr 20263 44684 h4: 0, r. a109 ; pseudo maincat claim 20264 44688 20264 44688 m25: ; prepare bs: 20265 44688 al w1 0 ; entries := 0; 20266 44690 al w0 a110 ; newkey := max catalog key; 20267 44692 jl. g0. ; goto init pseudo claims; 20268 44694 m260: al w2 0 ; claim 1 aux entry. (slices already claimed) insert entry r es 3 20269 44696 20269 44696 m26: ; create aux entry: 20270 44696 al w1 1 ; entries := 1; 20271 44698 al w0 -f51-1 ; 20272 44700 la. w0 d1.+f3 ; newkey := key.work; 20273 44702 20273 44702 g0: ; init pseudo claims: 20274 44702 al w3 -1 ; oldkey := -1; 20275 44704 ds. w2 h1. ; save (entries, slices); 20276 44706 20276 44706 hs. w1 h4. ; save entries 20277 44708 r. a109 ; in whole pseudo maincat entry claim; 20278 44710 al. w1 h4. ; maincat claim addr := pseudo claim; 20279 44712 jl. g3. ; goto get auxcat claim addr; 20280 44714 20280 44714 m27: ; permanent entry: 20281 44714 ; w2 = negative number of slices to claim 20282 44714 ac w2 x2 ; w2 := number of slices to claim; 20283 44716 al w1 1 ; entries := 1; 20284 44718 rl. w3 d10. ; oldkey := saved old key; 20285 44720 al w0 -f51-1 ; 20286 44722 la. w0 d1.+f3 ; newkey := key.work; 20287 44724 sl w0 x3 ; if newkey >= oldkey then 20288 44726 jl. g2. ; goto get maincat claim addr; 20289 44728 ; the rest of the algorithm supposes an ascending key-change. 20290 44728 ; in order to do this the entry- and slice-claims are negated 20291 44728 ac w2 x2 ; slices := - slices; 20292 44730 ac w1 x1 ; entries := - entries 20293 44732 rx w3 0 ; exchange keys; 20294 44734 jl. g2. ; goto get maincat claim addr; 20295 44736 m280: al w2 0 ; unclaim 1 main and aux entry. aux entry will be reclaimed later 20296 44738 20296 44738 m28: ; remove entry: 20297 44738 ; (as in permanent entry, the claims must be negated) 20298 44738 ; (w2 is already negative number of slices to claim) 20299 44738 am -1-0 ; entries := -1; 20300 44740 m29: ; change entry: 20301 44740 am 0-1 ; entries := 0; 20302 44742 m30: ; create entry: 20303 44742 al w1 1 ; entries := 1; 20304 44744 al w0 -f51-1 ; 20305 44746 la. w0 d1.+f3 ; newkey := key.work; 20306 44748 al w3 -1 ; oldkey := -1; 20307 44750 20307 44750 g2: ; get maincat claim addr: 20308 44750 ds. w2 h1. ; save (entries, slices); 20309 44752 rl w1 b25 ; w1 := maincat docaddr; 20310 44754 rl w1 x1+f60 ; w1 := rel claim addr.maindoc; 20311 44756 wa. w1 d2. ; w1 := abs addr of maincat claim in sender descr; 20312 44758 20312 44758 g3: ; get auxcat claim addr: 20313 44758 ; w0 = newkey 20314 44758 ; w1 = maincat claim addr 20315 44758 ; w3 = oldkey ( <= newkey ) 20316 44758 rl. w2 d4. ; 20317 44760 rl w2 x2+f60 ; 20318 44762 wa. w2 d2. ; w2 := abs addr of auxcat claim in sender descr; 20319 44764 20319 44764 ds. w2 h3. ; save (maincat claim addr, auxcat claim addr); 20320 44766 20320 44766 ld w0 1 ; oldkey := oldkey * 2; 20321 44768 hs. w0 h5. ; newkey := newkey * 2; 20322 44770 20322 44770 al w2 x3 ; current key := oldkey; 20323 44772 jl. g11. ; goto test key; 20324 44774 20324 44774 g10: ; next claim: 20325 44774 ; w2 = current key : even = test entry-claim 20326 44774 ; odd = test slice-claim 20327 44774 ; w3 = second scan : oldkey == false 20328 44774 ; max key + 1 == true 20329 44774 20329 44774 ; the claims are scanned twice: 20330 44774 ; first time the claims are just tested for claims exceeded 20331 44774 ; second time the claims are changed 20332 44774 20332 44774 al w1 x2 ; claim addr := current key 20333 44776 so w2 2.1 ; + if slice-claim 20334 44778 sl w2 a109*2-2; or current key >= minimum aux key then 20335 44780 am h3-h2 ; auxcat claim addr 20336 44782 wa. w1 h2. ; else maincat claim addr; 20337 44784 20337 44784 bz w0 x1+2 ; w0 := current claim(claim addr); 20338 44786 sz w2 2.1 ; rest := current claim 20339 44788 am h1-h0 ; - if slice claim then slices 20340 44790 ws. w0 h0. ; else entries; 20341 44792 20341 44792 sh w0 -1 ; if rest < 0 then 20342 44794 jl. n5. ; goto claims exceeded; 20343 44796 20343 44796 sn w3 a110+1 ; if second scan then 20344 44798 hs w0 x1+2 ; current claim(claim addr) := rest; 20345 44800 20345 44800 al w2 x2+1 ; increase(current key); 20346 44802 20346 44802 g11: ; test key: 20347 44802 h5 = k+1 20348 44802 se w2 ; newkey*2 ; if current key <> newkey then 20349 44804 jl. g10. ; goto next claim; 20350 44806 20350 44806 al w2 x3 ; current key := oldkey; 20351 44808 al w3 a110+1 ; oldkey := second scan := true; 20352 44810 se w2 x3 ; if second pass not done yet then 20353 44812 jl. g11. ; goto test key; 20354 44814 20354 44814 ; all claims in the interval oldkey-newkey have been tested and 20355 44814 ; changed, without having claims exceeded 20356 44814 20356 44814 jl. n1. ; skip 20357 44816 20357 44816 e. ; 20358 44816 20358 44816 20358 44816 20358 44816 ; prepare maincat entry 20359 44816 ; 20360 44816 ; the permanens key.work is set to the minimum of key.entry and 20361 44816 ; min aux cat key - 1. 20362 44816 ; slices to claim is set to zero 20363 44816 ; 20364 44816 ; call: w2 = entry address 20365 44816 ; m31 20366 44816 ; exit: w2 = slices = 0 20367 44816 20367 44816 m31: ; prepare maincat entry: 20368 44816 al w0 -f51-1 ; 20369 44818 la w0 x2+f3 ; w0 := permkey.entry; 20370 44820 sl w0 a109 ; if permkey >= min aux key then 20371 44822 al w0 a109-1 ; permkey := min aux key - 1; 20372 44824 hs. w0 d1.+f3 ; key.work := permkey; 20373 44826 al w2 0 ; w2 := slices to claim := 0; 20374 44828 jl. n0. ; next instruction; 20375 44830 20375 44830 20375 44830 ; set bs claims 20376 44830 ; 20377 44830 ; it is tested that the claims can be subtracted from 20378 44830 ; the parent and added to the childs claims 20379 44830 ; the claims are given to the child 20380 44830 ; 20381 44830 ; notice: the claims-change may be positive or negative 20382 44830 ; 20383 44830 ; call: m32 20384 44830 ; error return: result 1, if claims exceeded 20385 44830 ; result 3, if process does not exist 20386 44830 ; result 3, if process is not an internal process 20387 44830 ; result 3, if process is not a child of calling process 20388 44830 20388 44830 b. g10, h10 w. 20389 44830 20389 44830 m32: ; set bs claims: 20390 44830 jl. w3 e17. ; first proc; 20391 44832 je. w3 e75. ; move bs-params from sender to claim-array; 20392 44834 al. w2 d16. ; w2 := claim array; 20393 44836 rl. w3 d4. ; w3 := curdoc; 20394 44838 20394 44838 g0: ; convert next key: 20395 44838 al w0 0 ; 20396 44840 se w3 (b25) ; if curdoc = maincat docaddr 20397 44842 sl. w2 d16.+a109*4; or key >= min aux key then 20398 44844 rl w0 x2 ; keep (entrychange.key) 20399 44846 rs w0 x2 ; else entrychange.key := 0; 20400 44848 20400 44848 rl w0 x2+2 ; w0w1 := signed segmentchange.key; 20401 44850 ad w1 -24 ; 20402 44852 wd w1 x3+f64 ; slices := segments // slicelength.curdoc 20403 44854 sl w0 1 ; 20404 44856 al w1 x1+1 ; + sign (remainder); 20405 44858 sh w0 -1 ; 20406 44860 al w1 x1-1 ; 20407 44862 rs w1 x2+2 ; save in claim-array; 20408 44864 20408 44864 al w2 x2+4 ; increase key; 20409 44866 sh. w2 d16.+4*a110; if not all keys converted then 20410 44868 jl. g0. ; goto convert next key; 20411 44870 20411 44870 rs. w2 d1. ; second pass := false; 20412 44872 20412 44872 g5: ; next pass: 20413 44872 rl. w1 d2. ; w1 := sender; 20414 44874 rl. w2 d14. ; w2 := child; 20415 44876 20415 44876 wa w1 x3+f60 ; w1 := claimaddr.sender (curdoc); 20416 44878 wa w2 x3+f60 ; w2 := claimaddr.child (curdoc); 20417 44880 20417 44880 al. w3 d16. ; w3 := start of claim-array; ( = key 0 ) 20418 44882 20418 44882 g8: ; next key: 20419 44882 ; first test that the parent won't have claims exceeded 20420 44882 bz w0 x1 ; remainder := claim(key).sender 20421 44884 ws w0 x3 ; - claimchange(key); 20422 44886 sh w0 -1 ; if remainder < 0 then 20423 44888 jl. j1. ; goto result 1; (i.e. claims exceeded at sender) 20424 44890 sl. w3 (d1.) ; if second pass then 20425 44892 hs w0 x1 ; claim(key).sender := remainder; 20426 44894 20426 44894 ; parent claims was ok (till now) 20427 44894 ; test child claims 20428 44894 20428 44894 bz w0 x2 ; newclaim := claim(key).child 20429 44896 wa w0 x3 ; + claimchange(key); 20430 44898 sh w0 -1 ; if newclaim < 0 then 20431 44900 jl. j1. ; goto result 1; (i.e. claims excceded at child) 20432 44902 sl. w3 (d1.) ; if second pass then 20433 44904 hs w0 x2 ; claim(key).child := newclaim; 20434 44906 20434 44906 ; child-claims was also ok 20435 44906 ; try next key 20436 44906 20436 44906 al w1 x1+1 ; increase (sender claimaddr); 20437 44908 al w2 x2+1 ; increase (child claimaddr); 20438 44910 al w3 x3+2 ; increase (key); 20439 44912 20439 44912 sh. w3 d16.+4*a110+3; if not all keys tested then 20440 44914 jl. g8. ; goto next key; 20441 44916 20441 44916 ; all keys have been tested (or updated) 20442 44916 20442 44916 al. w3 d16.-2 ; 20443 44918 sn. w3 (d1.) ; if second pass then 20444 44920 jl. j0. ; goto result ok; 20445 44922 20445 44922 rs. w3 d1. ; second pass := true; 20446 44924 rl. w3 d4. ; w3 := curdoc; 20447 44926 jl. g5. ; goto next pass; 20448 44928 20448 44928 e. ; 20449 44928 20449 44928 20449 44928 ; if not bs-device then goto <not bs> 20450 44928 ; 20451 44928 ; the kind of the process description of curproc is tested to 20452 44928 ; find out whether or not it is a bs-device 20453 44928 ; 20454 44928 ; call: m34, <not bs addr> 20455 44928 ; error return: goto-action 1, if not bs-device; 20456 44928 20456 44928 m34: ; check bs-device: 20457 44928 rl. w2 (d11.) ; proc := nametable (cur proc name table address); 20458 44930 20458 44930 rl w1 x2+a10 ; w1 := kind.proc; 20459 44932 20459 44932 se w1 84 ; if kind = rcnet subprocess then 20460 44934 sn w1 85 ; 20461 44936 bz w1 x2+a63 ; kind := subkind.proc; 20462 44938 20462 44938 se w1 6 ; if kind = drum 20463 44940 sn w1 62 ; or kind = disc then 20464 44942 jl. n1. ; skip; 20465 44944 20465 44944 jl. n5. ; goto <not bs>; 20466 44946 20466 44946 20466 44946 20466 44946 ; search any chains (allowed state) 20467 44946 ; 20468 44946 ; finds a document on which the sender has enough claims 20469 44946 ; to create the entry described in entry.work 20470 44946 ; 20471 44946 ; call: m35, <allowed states> 20472 44946 ; error return: result 2, if document not found 20473 44946 ; result 2, if state.document not allowed 20474 44946 ; result 4, if no documents with enough claims 20475 44946 ; result 6, if document nameformat illegal 20476 44946 ; return: curdoc is defined 20477 44946 20477 44946 b. g10, h10 w. 20478 44946 20478 44946 m35: ; search any chains: 20479 44946 rl. w0 d1.+f7 ; w0 := size.work; 20480 44948 rl. w2 d1.+f11; w2 := docname(0).work; 20481 44950 20481 44950 sl w0 0 ; if size < 0 20482 44952 sz w2 -1<1 ; or docname(0) is neither 0 nor 1 then 20483 44954 jl. m36. ; goto search chain; 20484 44956 20484 44956 jl. w3 n10. ; w0 := allowed state := param; 20485 44958 hs. w0 h0. ; 20486 44960 20486 44960 ls w2 1 ; w2 := first drum rel or first disc rel; 20487 44962 20487 44962 g0: ; next device kind: 20488 44962 rl w2 x2+b22 ; w2 := first drum (or disc) chain entry in 20489 44964 ; name table; 20490 44964 jl. g5. ; goto test end of bs-devices; 20491 44966 ; (only relevant if devicekind = disc) 20492 44966 20492 44966 g1: ; test chain state: 20493 44966 rl w3 x2 ; doc := name table(entry); 20494 44968 bl w1 x3+f68 ; w1 := state.doc; 20495 44970 h0 = k+1 20496 44970 al w0 ; allowed state; 20497 44972 sh w0 (x3+f61) ; if docname.doc = 0 20498 44974 so w0 x1 ; or state.doc not allowed then 20499 44976 jl. g2. ; goto next chain; 20500 44978 rl w1 x3+f60 ; 20501 44980 wa. w1 d2. ; w1 := abs addr of claims in sender descr; 20502 44982 ; just test slice-claim, because it is irrellevant to test entry-claim 20503 44982 bz w1 x1+1 ; w1 := slice claim(key 0); 20504 44984 wm w1 x3+f64 ; segments := slices * slicelength; 20505 44986 sl. w1 (d1.+f7); if segments >= size.work then 20506 44988 jl. g10. ; goto document found; 20507 44990 20507 44990 g2: ; next chain: 20508 44990 al w2 x2+2 ; increase(entry); 20509 44992 g5: ; test end: 20510 44992 se w2 (b24) ; if entry <> top of chain list then 20511 44994 jl. g1. ; goto test chain state; 20512 44996 20512 44996 al w2 0 ; device kind := drum; 20513 44998 rx. w2 d1.+f11; 20514 45000 se w2 0 ; if old device kind <> drum then 20515 45002 jl. g0. ; goto next device kind; 20516 45004 20516 45004 ; all drums have been tested for slice-claims 20517 45004 ; and all discs have been tested (maybe even twice) for slice-claims 20518 45004 ; but no documents had enough claims 20519 45004 jl. j4. ; goto result 4; (claims exceeded) 20520 45006 20520 45006 g10: ; document found: 20521 45006 rs. w3 d4. ; curdoc := doc; 20522 45008 al. w1 d1.+f11; 20523 45010 al w2 x3+f61 ; move docname.curdoc to docname.work; 20524 45012 jl. w3 e32. ; 20525 45014 jl. n0. ; next instruction; 20526 45016 20526 45016 e. ; 20527 45016 20527 45016 d2: 0 ; sender: process description address of sender 20528 45018 d11: 0 ; cur proc name table address 20529 45020 d13: 0 ; children bits 20530 45022 d14: 0 ; d13+2 ; address of a process description 20531 45024 d15: 0 ; d13+4 ; end chain 20532 45026 20532 45026 20532 45026 20532 45026 ; procedure search chain (allowed state) 20533 45026 ; 20534 45026 ; searches the chaintables for a document with docname = docname.work 20535 45026 ; 20536 45026 ; call: m36, <allowed states> 20537 45026 ; error return: result 2, if document not found 20538 45026 ; result 2, if state.document not allowed 20539 45026 ; result 6, if document nameformat illegal 20540 45026 ; return: curdoc is defined 20541 45026 20541 45026 b. g10 w. 20542 45026 20542 45026 m36: ; search chain: 20543 45026 rl. w0 d1.+f7 ; 20544 45028 sl w0 0 ; if size.work >= 0 then 20545 45030 jl. g1. ; goto area; 20546 45032 20546 45032 jl. w3 e15. ; compute document address; 20547 45034 jl. g5. ; goto test state; 20548 45036 20548 45036 g1: ; area: 20549 45036 jl. w3 e45. ; find chain (docname.work); 20550 45038 d1+f11 ; 20551 45040 jl. g10. ;+4: not found: goto test document name; 20552 45042 ;+6: found: 20553 45042 20553 45042 g5: ; test state: 20554 45042 rs. w2 d4. ; curdoc := doc; 20555 45044 jl. w3 n10. ; w0 := allowed states := param; 20556 45046 bl w1 x2+f68 ; if state.curdoc is not allowed then 20557 45048 so w0 x1 ; 20558 45050 jl. j2. ; goto result 2; 20559 45052 20559 45052 jl. n0. ; next instruction; 20560 45054 20560 45054 g10: ; test document name: 20561 45054 al. w1 d1.+f5 ; 20562 45056 al w2 x1+f11-f5 ; move docname.work to name.work; 20563 45058 jl. w3 e32. ; 20564 45060 jl. w3 e24. ; test format; 20565 45062 jl. j2. ; goto result 2; 20566 45064 j2 = k-2 ; (stepping stone) 20567 45064 20567 45064 e. ; 20568 45064 20568 45064 20568 45064 20568 45064 ; set chainstate 20569 45064 ; 20570 45064 ; the state of curdoc chain is set 20571 45064 ; 20572 45064 ; call: m37, <new state> 20573 45064 20573 45064 m37: ; set chainstate: 20574 45064 jl. w3 n10. ; w0 := new state := param; 20575 45066 rl. w2 d4. ; w2 := curdoc; 20576 45068 hs w0 x2+f68 ; state.curdoc := new state; 20577 45070 jl. n0. ; next instruction; 20578 45072 20578 45072 20578 45072 20578 45072 ; find empty chain and prepare 20579 45072 ; 20580 45072 ; the kind is tested, whether it is a fast or slow device (drum/disc) 20581 45072 ; the size of the chaintable is tested against the corresponding 20582 45072 ; maximum size 20583 45072 ; an empty chain is found, and all the chain-link are cleared 20584 45072 ; (i.e. set to free) 20585 45072 ; the chainhead is copied (except first word of docname) 20586 45072 ; it is tested that the size of the catalog wont give too large 20587 45072 ; entry-claim 20588 45072 ; all claims on the device are given to the sender, while all other 20589 45072 ; internal processes will have their claims cleared 20590 45072 ; 20591 45072 ; call: m38 20592 45072 ; error return: result 5: illegal kind (neither fast not slow device) 20593 45072 ; result 5: too many slices 20594 45072 ; result 5: catalog too big, i.e. too many entries 20595 45072 ; result 7: no chains idle 20596 45072 20596 45072 b. g20, h10 w. 20597 45072 20597 45072 m38: ; find empty chain and prepare: 20598 45072 bz. w2 d1.+f53+f0; w2 := chain kind.chainhead; 20599 45074 ls w2 -3 ; 20600 45076 sl w2 2 ; if illegal kind then 20601 45078 jl. j5. ; goto result 5; 20602 45080 ; kind = 0 : fast device, i.e. drum 20603 45080 ; kind = 1 : slow device, i.e. disc 20604 45080 20604 45080 ls w2 1 ; 20605 45082 bz. w0 d1.+f66+f0; if last slice.chainhead 20606 45084 sl. w0 (x2+h0.) ; >= chainsize(kind) then 20607 45086 jl. j5. ; goto result 5; 20608 45088 20608 45088 ; find an empty chain of the specified kind 20609 45088 ; an empty chain is characterized by having first word of docname = 0 20610 45088 dl w3 x2+b22+2 ; w3 := top entry; 20611 45090 al w2 x2-2 ; w2 := base entry; 20612 45092 al w0 0 ; (empty docname) 20613 45094 g0: ; next chain: 20614 45094 al w2 x2+2 ; increase(entry); 20615 45096 sn w2 x3 ; if all chains(kind) are tested 20616 45098 jl. j7. ; goto result 7; (i.e. no chains idle) 20617 45100 20617 45100 rl w1 x2 ; doc := chain(entry); 20618 45102 se w0 (x1+f61) ; if first word of docname.doc <> 0 then 20619 45104 jl. g0. ; goto next chain; 20620 45106 20620 45106 ; a chaintable was found: clear all chainlinks 20621 45106 rs. w1 d4. ; curdoc := doc; 20622 45108 bz. w2 d1.+f66+f0; 20623 45110 wa w2 2 ; w2 := abs addr of last slice of curdoc chaintable; 20624 45112 al w0 -2048 ; w0 := free slice; 20625 45114 g2: ; clear next slice: 20626 45114 hs w0 x2 ; 20627 45116 al w2 x2-1 ; clear all slices in chain table 20628 45118 sl w2 x1 ; (notice: there is at least one slice) 20629 45120 jl. g2. ; 20630 45122 20630 45122 ; w1 = curdoc 20631 45122 jl. g5. ; goto init chainhead; 20632 45124 20632 45124 h0: a114 + f60 ; size of fast-chains (i.e. drums) 20633 45126 a116 + f60 ; size of slow-chains (i.e. discs) 20634 45128 20634 45128 20634 45128 20634 45128 ; set maincat and prepare 20635 45128 ; 20636 45128 ; maincat docaddr is set to curdoc 20637 45128 ; the pseudo-chainhead for main catalog is initialized 20638 45128 ; the size of main catalog is tested for too large entry-claim 20639 45128 ; all maincat entry-claims are given to sender, while all other 20640 45128 ; internal processes will have their maincat entry-claims cleared 20641 45128 ; 20642 45128 ; call: m39 20643 45128 ; error return: result 5: catalog size illegal (i.e. too many entries) 20644 45128 20644 45128 m39: ; set maincat and prepare: 20645 45128 rl. w1 d4. ; 20646 45130 rs w1 b25 ; maincat docaddr := curdoc; 20647 45132 20647 45132 rl. w1 d5. ; w1 := pseudo chaintable; 20648 45134 20648 45134 g5: ; init chainhead: 20649 45134 ; w1 = chaintable (or maincatalog pseudo chaintable) 20650 45134 rs. w1 h1. ; save(chaintable addr); 20651 45136 al w1 x1-f0 ; 20652 45138 al. w2 d1. ; move chainhead from work to chaintable; 20653 45140 jl. w3 e33. ; 20654 45142 20654 45142 rl. w1 h1. ; (docname.chain must stay cleared until 20655 45144 al w0 0 ; all checking is ended, because this is the 20656 45146 se. w1 (d5.) ; 20657 45148 rs w0 x1+f61 ; way to characterize an empty chain) 20658 45150 20658 45150 rs w0 x1+f70 ; catalog name table addr := 0; 20659 45152 20659 45152 ; compute number of entries in the catalog and compare this to 20660 45152 ; the maximum possible claim 20661 45152 al w0 f10 ; 20662 45154 wm w0 x1+f57 ; if number of entries.catalog 20663 45156 ld w0 12 ; exceeds 12 bit then 20664 45158 se w3 0 ; 20665 45160 jl. j5. ; goto result 5; (i.e. too many entries) 20666 45162 20666 45162 bz w3 x1+f66 ; slices := last slice number + 1; 20667 45164 al w3 x3+1 ; 20668 45166 hl w0 7 ; maxclaim := entries < 12 + slices; 20669 45168 20669 45168 g8: ; prepare claims: 20670 45168 ; w0 = max claims 20671 45168 rs. w0 h2. ; 20672 45170 20672 45170 ; initialize claims for all internal processes: 20673 45170 20673 45170 rl w2 b6 ; w2 := first internal in nametable; 20674 45172 ; (there is at least one, namely sender itself) 20675 45172 20675 45172 g10: ; next internal: 20676 45172 rl w3 x2 ; proc := nametable(entry); 20677 45174 sn. w3 (d2.) ; claim := 20678 45176 am. (h2.) ; if proc = sender then maxclaim 20679 45178 al w0 0 ; else 0; 20680 45180 20680 45180 rl. w1 d4. ; w1 := curdoc; 20681 45182 wa w3 x1+f60 ; claim addr := proc + claimrel.curdoc; 20682 45184 se. w1 (h1.) ; if chain <> curdoc then 20683 45186 jl. g15. ; goto init maincat entry-claim; 20684 45188 20684 45188 al w1 x3 ; 20685 45190 g11: ; init next key: 20686 45190 hs w0 x3+1 ; init slice-claim from claim; 20687 45192 sl w3 x1+a109*2 ; if key >= min aux key then 20688 45194 rs w0 x3+1 ; init entry-claim and slice-claim; 20689 45196 al w3 x3+2 ; increase(key); 20690 45198 sh w3 x1+a110*2 ; if key <= max cat key then 20691 45200 jl. g11. ; goto init next key; 20692 45202 20692 45202 g12: ; test more internals: 20693 45202 al w2 x2+2 ; increase(entry); 20694 45204 se w2 (b7) ; if entry < last internal in nametable then 20695 45206 jl. g10. ; goto next internal; 20696 45208 20696 45208 ; all internals have had their claims initialized 20697 45208 jl. n0. ; next instruction 20698 45210 20698 45210 g15: ; init maincat entry-claim: 20699 45210 al w1 x3 ; 20700 45212 ls w0 -12 ; ( w0 := entries ) 20701 45214 g16: ; init next maincat key: 20702 45214 hs w0 x3 ; init entry-claim(key); 20703 45216 al w3 x3+2 ; increase(key); 20704 45218 sh w3 x1+a109*2-1; if key < min aux key then 20705 45220 jl. g16. ; goto init next maincat key; 20706 45222 20706 45222 jl. g12. ; goto test more internals; 20707 45224 20707 45224 h1: 0 ; chaintable to be initialized 20708 45226 h2: 0 ; maxclaim ( = entries, slices) 20709 45228 20709 45228 20709 45228 ; stepping stones: 20710 45228 am e0 -e1 , e0=k-2 20711 45230 am e1 -e12 , e1=k-2 20712 45232 am e12-e15 , e12=k-2 20713 45234 am e15-e17 , e15=k-2 20714 45236 am e17-e18 , e17 = k-2 20715 45238 am e18-e19 , e18 = k-2 20716 45240 am e19-e20 , e19 = k-2 20717 45242 am e20-e26 , e20 = k-2 20718 45244 am e26-e31 , e26 = k-2 20719 45246 jl. e31. , e31 = k-2 20720 45248 jl. e32. , e32 = k-2 20721 45250 jl. e33. , e33 = k-2 20722 45252 jl. e43. , e43 = k-2 20723 45254 jl. e44. , e44 = k-2 20724 45256 jl. e45. , e45=k-2 20725 45258 jl. e46. , e46=k-2 20726 45260 jl. e25. , e25=k-2 20727 45262 jl. e47. , e47 = k-2 20728 45264 jl. e60. , e60 = k-2 20729 45266 jl. e74. , e74 = k-2 20730 45268 jl. e76. , e76 = k-2 20731 45270 20731 45270 20731 45270 20731 45270 ; terminate update of new chainhead 20732 45270 ; 20733 45270 ; the chaintable and the disc-process are linked, and the slicelength 20734 45270 ; is inserted in the process-description of the disc 20735 45270 ; first word of docname.chaintable is initialized, thus indicating 20736 45270 ; that the chain is no longer empty. 20737 45270 ; procfunc itself is inserted as user and reserver of the disc-process 20738 45270 ; 20739 45270 ; call: m40 20740 45270 20740 45270 m40: ; terminate update of new chainhead: 20741 45270 rl. w1 d4. ; w1 := curdoc; 20742 45272 rl. w2 d11. ; w2 := cur proc name table address; 20743 45274 rs w2 x1+f62 ; set document name table address; 20744 45276 20744 45276 rl. w0 d1.+f61+f0; 20745 45278 rs w0 x1+f61 ; first word of docname.chainhead := docname.work; 20746 45280 ; now the chaintable-head is completely initialized 20747 45280 ; (except state, which still is undefined) 20748 45280 20748 45280 rl w3 x2 ; proc := disc process description; 20749 45282 20749 45282 rl w2 x1+f64 ; slicelength.proc := slicelength; 20750 45284 ds w2 x3+a72 ; chaintable .proc := curdoc; 20751 45286 20751 45286 am (b1) ; idbit := idbit.procfunc; 20752 45288 rl w0 +a14 ; 20753 45290 rs w0 x3+a52 ; reserver.proc := procfunc; 20754 45292 lo w0 x3+a53 ; include procfunc as user of proc; 20755 45294 rs w0 x3+a53 ; 20756 45296 20756 45296 jl. n0. ; next instruction; 20757 45298 20757 45298 20757 45298 20757 45298 ; terminate use of chain and disc 20758 45298 ; 20759 45298 ; ************************************************** 20760 45298 ; * * 20761 45298 ; * notice that the following is executed disabled * 20762 45298 ; * * 20763 45298 ; ************************************************** 20764 45298 ; 20765 45298 ; the first word of docname.curdoc is cleared, thus indicating 20766 45298 ; that the chain is empty 20767 45298 ; removes the links between disc-process and chaintable 20768 45298 ; removes the name of disc-proc 20769 45298 ; excludes procfunc as user and reserver of disc-proc 20770 45298 ; all internal processes will have their claims cleared 20771 45298 ; 20772 45298 ; call: m41 20773 45298 20773 45298 m41: ; terminate use of chain and disc: 20774 45298 rl. w1 d4. ; w1 := curdoc; 20775 45300 rs. w1 h1. ; save (chaintable address); 20776 45302 jd. 2 ; disable; 20777 45304 al w2 0 ; 20778 45306 rs w2 x1+f61 ; first word of docname.curdoc := 0; 20779 45308 20779 45308 rx w2 x1+f62 ; document name table addr := 0; 20780 45310 20780 45310 rl w2 x2 ; proc := disc-process; 20781 45312 20781 45312 rl w1 b1 ; exclude procfunc as user of the process; 20782 45314 rl w0 x2+a53 ; 20783 45316 ws w0 x1+a14 ; (it was already user) 20784 45318 rs w0 x2+a53 ; 20785 45320 20785 45320 ld w1 -100 ; 20786 45322 rs w0 x2+a11 ; name(0).proc := 0; 20787 45324 ; (this will prevent further use of disc-proc) 20788 45324 rs w0 x2+a52 ; reserver.proc := 0; 20789 45326 20789 45326 ds w1 x2+a72 ; chaintable.proc := slicelength.proc := 0; 20790 45328 20790 45328 ; w0 = 0 ( = max claims ) 20791 45328 je. g8. ; enable, goto prepare claims; 20792 45330 20792 45330 e. ; 20793 45330 20793 45330 20793 45330 20793 45330 ; clean catalog 20794 45330 ; 20795 45330 ; clears all segments in the current catalog (which must be maincat) 20796 45330 ; 20797 45330 ; call: m42 20798 45330 ; error return: result 2, if catalog io-error 20799 45330 20799 45330 b. g10, h10 w. 20800 45330 20800 45330 m42: ; clean catalog: 20801 45330 jl. w3 e7. ; (terminate update); 20802 45332 ; w2 = start of catalog buffer 20803 45332 al w0 -1 ; 20804 45334 al w1 x2+f9 ; 20805 45336 g1: ; clear next word of catalog buffer: 20806 45336 rs w0 x2 ; 20807 45338 al w2 x2+2 ; set all words of catalog buffer to -1 20808 45340 se w2 x1 ; thus indicating all entries are free; 20809 45342 jl. g1. ; 20810 45344 20810 45344 al w0 0 ; entry count.catbuffer := 0; 20811 45346 rs w0 x2 ; 20812 45348 20812 45348 ; segment number := 0; 20813 45348 20813 45348 g2: ; next segment: 20814 45348 rs. w0 (h0.) ; save (segment number); 20815 45350 jl. w3 e9. ; prepare update; 20816 45352 jl. w3 e7. ; terminate update; i.e. write the catalog buffer 20817 45354 ; w1 = segment number 20818 45354 al w0 x1+1 ; increase (segment number); 20819 45356 ws. w1 (h1.) ; 20820 45358 se w1 -1 ; if segment number <> size of curcat then 20821 45360 jl. g2. ; goto next segment; 20822 45362 20822 45362 ; now all catalog segments have been cleared 20823 45362 jl. n0. ; next instruction 20824 45364 20824 45364 h0: d8 + f36 ; address of segment number in cat-message 20825 45366 h1: c0 ; address of size of curcat 20826 45368 20826 45368 e. ; 20827 45368 20827 45368 20827 45368 20827 45368 ; check idle bs-device or still same name 20828 45368 ; 20829 45368 ; if the disc-process has a link to a chaintable (i.e. chain.disc <> 0) 20830 45368 ; the new name must correspond with docname.chain 20831 45368 ; (used after intervention on a disc). 20832 45368 ; otherwise there are no further limitations on the new process-name. 20833 45368 ; 20834 45368 ; call: m43, <idle bs addr> 20835 45368 ; error return: result 3, if chain.proc <> 0 and newname <> docname.chain.proc 20836 45368 ; result 6, if newname(0) = 0 20837 45368 ; goto-action 1, if chain.proc = 0 20838 45368 20838 45368 m43: ; check idle bs-device or test still same name: 20839 45368 rl. w2 (d11.) ; 20840 45370 rl w2 x2+a71 ; chain := chain.curproc; 20841 45372 sn w2 0 ; if chain = 0 then 20842 45374 jl. n5. ; goto <idle bs-device> 20843 45376 20843 45376 rs. w2 d4. ; curdoc := chain; 20844 45378 20844 45378 ; test that name.work = docname.chain 20845 45378 ; (e.g. find chain with docname = name.work and test same chain) 20846 45378 20846 45378 jl. w3 e45. ; find chain (name.work); 20847 45380 d1+f5 ; 20848 45382 jl. j3. ;+4: not found: result 3; (not same name at all) 20849 45384 ;+6: found: 20850 45384 sn. w2 (d4.) ; if chain = curdoc then 20851 45386 jl. n1. ; skip; (i.e. name.chain = name.work) 20852 45388 20852 45388 jl. j3. ; result 3; (not same name) 20853 45390 j3 = k-2 ; (stepping stone) 20854 45390 20854 45390 20854 45390 20854 45390 ; search best area process 20855 45390 ; 20856 45390 ; call: m45, <not found addr> 20857 45390 ; error return: goto-action 1, if area process not found 20858 45390 20858 45390 m45: ; search best area process: 20859 45390 jl. w3 e47. ; search best process 20860 45392 b5 ; between first area process 20861 45394 b6 ; and top area process; 20862 45396 jl. n5. ;+6: not found: goto <not found> 20863 45398 20863 45398 ; w2 = area- (or pseudo-) process 20864 45398 rl w0 x2+a10 ; w0 := kind.proc; 20865 45400 sn w0 f38 ; if kind.proc = area process then 20866 45402 jl. n1. ; skip; 20867 45404 20867 45404 jl. n5. ; goto <not area>; 20868 45406 20868 45406 20868 45406 20868 45406 ; setup area process 20869 45406 ; 20870 45406 ; if the area process already exists, the specified process 20871 45406 ; is included as user (in case it has resources) 20872 45406 ; otherwise the area-claim of the process is tested, 20873 45406 ; and an empty area process is initialized according to entry.work 20874 45406 ; 20875 45406 ; call: (entry.work contains the entry) 20876 45406 ; m46, <process code> (code = 0 : procfunc, code = 2 : sender) 20877 45406 ; 20878 45406 ; error return: result 1, if area claims exceeded 20879 45406 ; return: cur proc name table address corresponds to the area process 20880 45406 ; the specified process is included as user of the area process 20881 45406 20881 45406 b. g10, h10 w. 20882 45406 20882 45406 m46: ; setup area process: 20883 45406 jl. w3 n10. ; w0 := process code := param; 20884 45408 am (0) ; 20885 45410 rl. w1 (h0.) ; internal := proctable (process code); 20886 45412 rs. w1 h1. ; 20887 45414 20887 45414 jl. w3 e47. ; search best area process; 20888 45416 b5 ; 20889 45418 b6 ; 20890 45420 jl. g1. ;+6: not found: goto test area claim; 20891 45422 20891 45422 ; an area process was found, but was it the rigth one, i.e how about the base 20892 45422 ; w0w1 = base.proc 20893 45422 sn. w0 (d1.+f1); if base.proc <> base.work then 20894 45424 se. w1 (d1.+f2); 20895 45426 jl. g1. ; goto test area claim; 20896 45428 20896 45428 ; it was the correct area proces 20897 45428 jl. g5. ; goto include; 20898 45430 20898 45430 g1: ; test area claim: 20899 45430 rl. w1 h1. ; 20900 45432 bz w0 x1+a20 ; if area claim.internal = 0 then 20901 45434 sn w0 0 ; 20902 45436 jl. j1. ; goto result 1; i.e. claims exceeded 20903 45438 20903 45438 ; the internal process has the claim of at least one area process, 20904 45438 ; i.e. at least one empty area process exist. 20905 45438 ; find that one and initialize it. 20906 45438 jl. w3 e44. ; find empty area process; 20907 45440 b5 ; 20908 45442 rl. w3 (d11.) ; 20909 45444 ld w1 -100 ; 20910 45446 ds w1 x3+a412 ; access counters:=0,0; 20911 45448 jl. w3 g10. ; init area(enabled); 20912 45450 20912 45450 ; an area process exists now, corresponding to entry.work 20913 45450 g5: ; include: 20914 45450 rl. w2 h1. ; w2 := internal; 20915 45452 rl. w3 (d11.) ; w3 := area process; 20916 45454 20916 45454 rl w1 x3+a53 ; w1 := users.area process; 20917 45456 sz w1 (x2+a14) ; if internal is already user then 20918 45458 jl. n0. ; next instruction; 20919 45460 ; (only when it existed at start) 20920 45460 20920 45460 al w0 -1 ; 20921 45462 ba w0 x2+a20 ; 20922 45464 sn w0 -1 ; if area claim.sender = 0 then 20923 45466 jl. j1. ; goto result 1; i.e. claims exceeded 20924 45468 j1 = k-2 ; (stepping stone) 20925 45468 20925 45468 hs w0 x2+a20 ; decrease (area claim.sender); 20926 45470 lo w1 x2+a14 ; include internal as user of area process; 20927 45472 rs w1 x3+a53 ; 20928 45474 20928 45474 jl. n0. ; next instruction 20929 45476 20929 45476 20929 45476 20929 45476 ; subprocedure init area 20930 45476 ; 20931 45476 ; initializes the area process from information given in entry.work 20932 45476 ; 20933 45476 ; an empty area process may be initialized enabled 20934 45476 ; an existing - - must - - disabled 20935 45476 ; 20936 45476 ; call: w3 = link 20937 45476 20937 45476 g10: ; procedure init area: 20938 45476 rs. w3 h2. ; save (return); 20939 45478 al. w2 d1. ; move from: entry.work 20940 45480 rl. w3 (d11.) ; to: area process the following: 20941 45482 20941 45482 al w0 f38 ; 20942 45484 rs w0 x3+a10 ; kind ( = area process) 20943 45486 20943 45486 dl w1 x2+f11+2 ; 20944 45488 ds w1 x3+a62+2 ; docname 20945 45490 dl w1 x2+f11+6 ; 20946 45492 ds w1 x3+a62+6 ; 20947 45494 20947 45494 bz w0 x2+f4 ; 20948 45496 rs w0 x3+a60 ; first slice 20949 45498 20949 45498 rl w0 x2+f7 ; 20950 45500 rs w0 x3+a61 ; size 20951 45502 20951 45502 dl w1 x2+f2 ; 20952 45504 ds w1 x3+a49 ; base 20953 45506 20953 45506 ; notice: name(0) is moved last 20954 45506 dl w1 x2+f5+6 ; 20955 45508 ds w1 x3+a11+6 ; name 20956 45510 dl w1 x2+f5+2 ; 20957 45512 ds w1 x3+a11+2 ; 20958 45514 20958 45514 jl. (h2.) ; return; 20959 45516 20959 45516 h0: b1 ; process table: param = 0 : procfunc 20960 45518 d20: d2 ; param = 2 : sender 20961 45520 20961 45520 h1: 0 ; internal 20962 45522 h2: 0 ; return from init area 20963 45524 20963 45524 20963 45524 20963 45524 ; include in area process 20964 45524 ; 20965 45524 ; the internal process, specified in the parameter is included 20966 45524 ; as user of the area process 20967 45524 ; 20968 45524 ; call: m47, <process code> 20969 45524 ; error return: result 1, if area claims exceeded 20970 45524 20970 45524 m47: ; include in area process: 20971 45524 jl. w3 n10. ; w0 := process code := param; 20972 45526 am (0) ; 20973 45528 rl. w1 (h0.) ; internal := proctable (process code); 20974 45530 rs. w1 h1. ; 20975 45532 jl. g5. ; goto include; 20976 45534 20976 45534 20976 45534 20976 45534 ; if area process then reinit area process 20977 45534 ; 20978 45534 ; it is tested, that an area process was found earlier. 20979 45534 ; in this case it will be re-initialized from the current entry.work 20980 45534 ; 20981 45534 ; call: m48 20982 45534 20982 45534 m48: ; reinit area process: 20983 45534 rl. w2 d11. ; if cur proc name table address 20984 45536 sl w2 (b5) ; does not outpoint an area process then 20985 45538 sl w2 (b6) ; 20986 45540 jl. n0. ; next instruction; 20987 45542 20987 45542 jd. w3 g10. ; init area process disabled; 20988 45544 20988 45544 je. n0. ; enable 20989 45546 ; next instruction 20990 45546 20990 45546 e. ; 20991 45546 20991 45546 20991 45546 20991 45546 ; make sender to reserver of area process 20992 45546 ; 20993 45546 ; call: m49 20994 45546 20994 45546 m49: ; make sender reserver: 20995 45546 rl. w1 d2. ; w1 := sender; 20996 45548 rl. w2 (d11.) ; w2 := area process; 20997 45550 rl w0 x1+a14 ; w0 := idbit.sender; 20998 45552 rs w0 x2+a52 ; reserver.areaproc := sender; 20999 45554 20999 45554 jl. n0. ; next instruction 21000 45556 n0 = k-2 ; (stepping stone) 21001 45556 21001 45556 21001 45556 21001 45556 ; if area process then delete area process 21002 45556 ; 21003 45556 ; the first word of name.proc is cleared, indicating an empty areaprocess. 21004 45556 ; reserver.proc and users.proc are cleared. 21005 45556 ; all internal processes who were users of the area process will have 21006 45556 ; their area-claim increased. 21007 45556 ; 21008 45556 ; call: m50 21009 45556 21009 45556 b. g10 w. 21010 45556 21010 45556 m50: ; if areaprocess then delete area process: 21011 45556 rl. w2 d11. ; w2 := name table address of possible area process; 21012 45558 sl w2 (b5) ; if not an area process then 21013 45560 sl w2 (b6) ; 21014 45562 jl. n0. ; next instruction 21015 45564 21015 45564 rl w3 x2 ; proc := area process; 21016 45566 21016 45566 ; notice: all the remove is performed enabled: 21017 45566 ld w2 -100 ; 21018 45568 rl w0 x3+a53 ; current users := users.proc; 21019 45570 ds w2 x3+a53 ; clear: reserver.proc, users.proc 21020 45572 rs w2 x3+a11 ; name(0) 21021 45574 rs w2 x3+a50 ; docaddr 21022 45576 21022 45576 ; scan all internal processes and maybe increase their area-claim 21023 45576 rl w2 b6 ; w2 := first internal in name table; 21024 45578 g1: ; next internal: 21025 45578 rl w3 x2+0 ; proc := nametable(entry); 21026 45580 al w1 1 ; 21027 45582 ba w1 x3+a20 ; 21028 45584 sz w0 (x3+a14) ; if proc was user of area process then 21029 45586 hs w1 x3+a20 ; increase (area claim.proc); 21030 45588 al w2 x2+2 ; 21031 45590 se w2 (b7) ; if not all internal processes tested then 21032 45592 jl. g1. ; goto next internal; 21033 45594 21033 45594 jl. n0. ; next instruction 21034 45596 21034 45596 e. ; 21035 45596 21035 45596 21035 45596 21035 45596 ; find empty entry 21036 45596 ; 21037 45596 ; the current catalog is searched for an empty catalog entry 21038 45596 ; 21039 45596 ; call: m55, <no room addr> 21040 45596 ; error return: result 2, if catalog io-error 21041 45596 ; goto-action 1, if no empty entries were found 21042 45596 21042 45596 m55: ; find empty entry: 21043 45596 jl. w3 e10. ; search free entry; 21044 45598 jl. n5. ;+2: no room: goto <no room> 21045 45600 jl. n1. ; skip 21046 45602 21046 45602 21046 45602 21046 45602 ; modify cur entry 21047 45602 ; 21048 45602 ; the entry, previously found by ..find empty entry.. or some other 21049 45602 ; search-routines is modified by the current contents of work. 21050 45602 ; 21051 45602 ; call: m56 21052 45602 ; error return: result 2, if catalog io-error 21053 45602 21053 45602 m56: ; modify cur entry: 21054 45602 jl. (2), e12; set cur entry and return; 21055 45606 21055 45606 21055 45606 21055 45606 ; delete cur entry 21056 45606 ; 21057 45606 ; the entry, previously found by some search-routines, is deleted 21058 45606 ; 21059 45606 ; call: m57 21060 45606 ; error return: result 2, if catalog io-error 21061 45606 21061 45606 m57: ; delete cur entry: 21062 45606 jl. (2), e13; delete cur entry and return; 21063 45610 21063 45610 21063 45610 21063 45610 ; set aux entry 21064 45610 ; 21065 45610 ; if the entry does not exist already in the auxcat, it will be 21066 45610 ; created. 21067 45610 ; finally entry.work is moved to that entry 21068 45610 ; 21069 45610 ; call: m58, <overlap or no room addr> 21070 45610 ; error return: result 2, if catalog io-error 21071 45610 ; goto-action 1, if entry could not be created 21072 45610 ; (i.e. overlapping intervals or no room) 21073 45610 21073 45610 m58: ; set aux entry: 21074 45610 al. w3 p0. ; 21075 45612 jl. n20. ; call(set aux); 21076 45614 21076 45614 21076 45614 21076 45614 ; delete aux entry 21077 45614 ; 21078 45614 ; if the entry exists in the aux catalog, it will be removed 21079 45614 ; (if it does'nt exist nothing will be deleted) 21080 45614 ; 21081 45614 ; call: m59 21082 45614 ; error return: result 2, if catalog io-error 21083 45614 21083 45614 m59: ; delete aux entry: 21084 45614 al. w3 p1. ; 21085 45616 jl. n20. ; call(delete aux); 21086 45618 21086 45618 21086 45618 ;stepping stones: 21087 45618 jl. e31. , e31=k-2 21088 45620 jl. e92. , e92=k-2 21089 45622 jl. n1. , n1 =k-2 21090 45624 jl. n5. , n5 =k-2 21091 45626 21091 45626 ; clear access counters.work 21092 45626 ; 21093 45626 ; the write and read access counters in the statarea of work is cleared. 21094 45626 ; 21095 45626 ; call: m60 21096 45626 21096 45626 m60: ; clear access counters: 21097 45626 ld w1 -100 ; 21098 45628 ds. w1 d30.+4 ; access counters.work:=0,0; 21099 45630 jl. n0. ; next instruction; 21100 45632 21100 45632 21100 45632 ; update and insert statarea 21101 45632 ; updates last change in statarea of work and moves statarea.work to current entry. 21102 45632 ; 21103 45632 ; call: m62 21104 45632 21104 45632 m62: ; update and insert statarea: 21105 45632 dl w1 b13+2 ; 21106 45634 ld w1 5 ; now:=monitor time shift 5; 21107 45636 rs. w0 d30.+0 ; last change:=word0(now); 21108 45638 rs. w0 d30.+6 ; last used:=word0(now) 21109 45640 21109 45640 21109 45640 ; move statarea.work to statarea.entry 21110 45640 21110 45640 ; 21111 45640 ; moves statarea.work to statarea.entry (=docname area) 21112 45640 ; 21113 45640 ; call: m63 21114 45640 21114 45640 m63: ; move statarea.work to statarea.entry: 21115 45640 jl. w3 e9. ; prepare update; 21116 45642 am e49-e50; 21117 45644 21117 45644 ; move statarea.entry to statarea.work 21118 45644 ; 21119 45644 ; moves statarea.entry (=docname area in aux cat) to statarea.work 21120 45644 ; 21121 45644 ; call: m64 21122 45644 21122 45644 m64: ; move statarea.entry to statarea.work: 21123 45644 jl. w3 e50. ; get statinf; 21124 45646 jl. n0. ; next instruction; 21125 45648 21125 45648 21125 45648 21125 45648 ; set base and name 21126 45648 ; 21127 45648 ; base.work and name.work are taken from catbase.sender and w3-name.sender 21128 45648 ; 21129 45648 ; call: m65 21130 45648 21130 45648 m65: ; set base and name: 21131 45648 rl. w1 d2. ; w1:=sensed; 21132 45650 dl w1 x1+a43 ; 21133 45652 ds. w1 d1.+f2 ; base.work := catbase.sender; 21134 45654 jl. w3 e90. ; move name.sender to name.work; 21135 45656 jl. n0. ; next instruction 21136 45658 21136 45658 21136 45658 21136 45658 ; docname.work := docname.chain 21137 45658 ; 21138 45658 ; call: m66 21139 45658 21139 45658 m66: ; init docname.work from docname.curdoc: 21140 45658 am f61-f55; namerel := docname rel; 21141 45660 21141 45660 ; name.work := name.chain 21142 45660 ; 21143 45660 ; call: m67 21144 45660 21144 45660 m67: ; init name.work from name.curdoc: 21145 45660 al w2 f55 ; namerel := name rel; 21146 45662 al. w1 x2+d1.+f0 ; to-addr := work + namerel; 21147 45664 wa. w2 d4. ; from-addr := curdoc + namerel; 21148 45666 jl. e32. ; move name 21149 45668 ; and return; 21150 45668 21150 45668 21150 45668 21150 45668 ; name.work := name.pseudochain ( = main catalog name ) 21151 45668 ; 21152 45668 ; call: m68 21153 45668 21153 45668 m68: ; init name.work from maincat name: 21154 45668 al. w1 d1.+f5 ; 21155 45670 rl. w2 d5. ; 21156 45672 al w2 x2+f55 ; move name.pseudochain to name.work; 21157 45674 jl. e32. ; (and return) 21158 45676 21158 45676 21158 45676 21158 45676 ; base.work := interval for catalogs 21159 45676 ; 21160 45676 ; call: m70 21161 45676 21161 45676 m70: ; init base.work from catalog interval: 21162 45676 dl w1 b45 ; 21163 45678 ds. w1 d1.+f2 ; base.work := catalog interval; 21164 45680 jl. n0. ; next instruction 21165 45682 21165 45682 21165 45682 21165 45682 ; test new base ( = w0w1.sender ) 21166 45682 ; 21167 45682 ; the new base must be either: 21168 45682 ; 1. equal to stdbase (or maxbase) 21169 45682 ; or 2. inside stdbase 21170 45682 ; or 3. between stdbase and maxbase 21171 45682 ; 21172 45682 ; call: m71 21173 45682 ; error return: result 4, if illegal new base 21174 45682 ; return: w0w1 = new base 21175 45682 21175 45682 b. g10 w. 21176 45682 ;test catbase of internal 21177 45682 m69: rl. w3 d1.+f5 ; if name(0):= 0 21178 45684 sn w3 0 ; then proc:=sender 21179 45686 jl. m71. ; 21180 45688 jl. w3 e17. ; else proc:=child.sender 21181 45690 al w2 x3 ; 21182 45692 je. g0. ; test new base 21183 45694 21183 45694 m71: ; test new base: 21184 45694 rl. w2 d2. ; w2 := sender; 21185 45696 al w1 x2 ; 21186 45698 21186 45698 g0: dl w1 x1+a29 ; newbase := w0w1.sender; 21187 45700 21187 45700 sh w1 (x2+a44-0) ; if newupper > maxupper 21188 45702 sl w0 x1+1 ; or newlower > newupper then 21189 45704 jl. j4. ; goto result 4; 21190 45706 ; (i.e. not inside maxbase or illegal base) 21191 45706 21191 45706 sl w0 (x2+a45-2) ; if newlower < stdlower then 21192 45708 jl. g5. ; begin <* test between stdbase and maxbase *> 21193 45710 al w3 x1+1 ; (trick) 21194 45712 sl w0 (x2+a44-2) ; if newlower < maxlower <* outside maxbase *> 21195 45714 sh w3 (x2+a45-0) ; or newupper < stdupper <* embraces stdlower *> 21196 45716 jl. j4. ; then goto result 4; 21197 45718 21197 45718 ; at this point: maxlower <= newlower < stdlower 21198 45718 ; stdupper <= newupper <= maxupper 21199 45718 jl. n0. ; next instruction 21200 45720 21200 45720 g5: ; end; 21201 45720 21201 45720 ; at this point: stdlower <= newlower 21202 45720 ; newupper <= maxupper 21203 45720 21203 45720 se w0 (x2+a45-2) ; if newlower = stdlower <* irrellevant newupper *> 21204 45722 sh w1 (x2+a45-0) ; or newupper <= stdupper <* inside stdbase *> 21205 45724 jl. n0. ; then next instruction; 21206 45726 21206 45726 ; this time the following was allowed: 21207 45726 ; stdlower = newlower <= newupper <= maxupper 21208 45726 ; or stdlower < newlower <= newupper <= stdupper 21209 45726 21209 45726 jl. j4. ; goto result 4; 21210 45728 j4 = k-2 ; (stepping stone) 21211 45728 21211 45728 e. ; 21212 45728 21212 45728 21212 45728 21212 45728 ; save oldbase, base.work := w0w1.sender 21213 45728 ; 21214 45728 ; call: w0w1 = newbase 21215 45728 ; m72, <same base addr> 21216 45728 ; 21217 45728 ; error return: goto-action 1, if newbase = oldbase 21218 45728 21218 45728 b. g10, h10 w. 21219 45728 21219 45728 m72: ; save oldbase: 21220 45728 dl. w3 d1.+f2 ; 21221 45730 ds. w3 h1. ; save (base.work); 21222 45732 21222 45732 ds. w1 d1.+f2 ; base.work := newbase; 21223 45734 21223 45734 sn w0 x2 ; if newbase <> oldbase then 21224 45736 se w1 x3 ; 21225 45738 jl. n1. ; skip; 21226 45740 21226 45740 jl. n5. ; goto <same base>; 21227 45742 21227 45742 h0: 0 ; old lower base 21228 45744 h1: 0 ; old upper base 21229 45746 21229 45746 21229 45746 21229 45746 ; restore old base 21230 45746 ; 21231 45746 ; call: m73 21232 45746 21232 45746 m73: ; restore old base: 21233 45746 dl. w1 h1. ; 21234 45748 ds. w1 d1.+f2 ; base.work := oldbase; 21235 45750 jl. n0. ; next instruction; 21236 45752 21236 45752 e. ; 21237 45752 21237 45752 21237 45752 21237 45752 ; set catbase of internal 21238 45752 ; 21239 45752 ; if first word of name.w3.sender = 0, the catbase of sender is set 21240 45752 ; otherwise name must outpoint a child of sender: 21241 45752 ; catbase.child := newbase 21242 45752 ; 21243 45752 ; call: w0w1 = newbase 21244 45752 ; w2 = sender 21245 45752 ; m74 21246 45752 ; 21247 45752 ; error return: result 2, if state.child <> waiting for start by parent 21248 45752 ; result 3, if internal not found 21249 45752 ; result 3, if internal not child 21250 45752 ; result 6, if nameformat illegal 21251 45752 ; return: is always enabled 21252 45752 21252 45752 b. g10 w. 21253 45752 21253 45752 m74: ; set catbase of internal: 21254 45752 rl. w3 d1.+f5 ; if name(0) = 0 then 21255 45754 sn w3 0 ; goto set base; 21256 45756 jl. g5. ; (i.e. own process) 21257 45758 21257 45758 jl. w3 e17. ; first proc; 21258 45760 ; w1 = sender, w3 = child 21259 45760 c.-1 21260 45760 bz w0 x3+a13 ; if state.child 21261 45760 se w0 f47 ; <> waiting for start by parent then 21262 45760 je. j2. ; enabled goto result 2; 21263 45760 z. 21264 45760 dl w1 x1+a29 ; w0w1 := newbase.sender; 21265 45762 al w2 x3 ; internal := child; 21266 45764 21266 45764 g5: ; set base: 21267 45764 ; w0w1 = newbase 21268 45764 ; w2 = internal 21269 45764 ds w1 x2+a43 ; catbase.internal := newbase; 21270 45766 je. n0. ; enable (if after check of child) 21271 45768 ; next instruction; 21272 45768 21272 45768 e. ; 21273 45768 21273 45768 21273 45768 21273 45768 ; test base.work, key.work 21274 45768 ; 21275 45768 ; the consistency of base and key is checked: 21276 45768 ; if key < min global key then base must be inside stdbase 21277 45768 ; 21278 45768 ; call: m75, <error addr> 21279 45768 ; error return: goto-action 1, if base,key inconsistent 21280 45768 21280 45768 m75: ; test base and key: 21281 45768 al w0 -f51-1 ; 21282 45770 la. w0 d1.+f3 ; key := key.work; 21283 45772 sl w0 a111 ; if key >= min global key then 21284 45774 jl. n1. ; skip; 21285 45776 21285 45776 rl. w2 d2. ; w2 := sender; 21286 45778 dl. w1 d1.+f2 ; w0w1 := base.work; 21287 45780 al w1 x1-1 ; (codetrick) 21288 45782 21288 45782 sl w0 (x2+a45-2) ; if base.work is outside stdbase.sender then 21289 45784 sl w1 (x2+a45-0) ; 21290 45786 jl. n5. ; goto <error>; 21291 45788 21291 45788 jl. n1. ; skip; 21292 45790 21292 45790 21292 45790 21292 45790 ; test auxkey, interval 21293 45790 ; 21294 45790 ; tests that: min aux key <= key.work <= max cat key 21295 45790 ; and that base.work is legal and not outside catalog interval 21296 45790 ; 21297 45790 ; notice: it is thus allowed to make any kind of intervals, 21298 45790 ; independant of maxbase.sender and stdbase.sender 21299 45790 ; 21300 45790 ; call: m76 21301 45790 ; error return: result 5, if key.work not a legal aux-key 21302 45790 ; result 5, if base.work illegal 21303 45790 21303 45790 m76: ; test auxkey and interval: 21304 45790 al w0 -f51-1 ; 21305 45792 la. w0 d1.+f3 ; key := key.work; 21306 45794 sl w0 a109 ; if key < min aux key 21307 45796 sl w0 a110+1 ; or key > max cat key then 21308 45798 jl. j5. ; goto result 5; 21309 45800 21309 45800 dl. w2 d1.+f2 ; w1w2 := base.work; 21310 45802 21310 45802 sl w1 (b45-2) ; if lower base < minimum 21311 45804 sl w1 x2+1 ; or lower base > upper base 21312 45806 jl. j5. ; 21313 45808 21313 45808 sh w2 (b45) ; or upper base > maximum then 21314 45810 jl. n0. ; goto result 5; 21315 45812 jl. j5. ; next instruction; 21316 45814 j5 = k-2 ; (stepping stone) 21317 45814 21317 45814 21317 45814 21317 45814 ; if key.work < min aux key then goto ... 21318 45814 ; 21319 45814 ; call: m77, <not aux key> 21320 45814 ; error return: goto-action 1, if key < min aux key 21321 45814 21321 45814 m77: ; test aux key: 21322 45814 al w0 -f51-1 ; 21323 45816 la. w0 d1.+f3 ; key := key.work; 21324 45818 sl w0 a109 ; if key >= min aux key then 21325 45820 jl. n1. ; skip; 21326 45822 21326 45822 jl. n5. ; goto <not aux key>; 21327 45824 21327 45824 21327 45824 21327 45824 ; save oldkey and test newkey 21328 45824 ; 21329 45824 ; old key is saved 21330 45824 ; the new key must obey: 0 <= new key <= max cat key 21331 45824 ; key.work := new key; 21332 45824 ; 21333 45824 ; call: m78 21334 45824 ; error return: result 4, if newkey illegal 21335 45824 21335 45824 b. g10 w. 21336 45824 21336 45824 m78: ; save oldkey and test newkey: 21337 45824 al w0 -f51-1 ; 21338 45826 la. w0 d1.+f3 ; key := key.work; 21339 45828 rs. w0 d10. ; oldkey := key; 21340 45830 21340 45830 rl. w1 d2. ; w1 := sender; 21341 45832 rl w0 x1+a29 ; newkey := w1.sender; 21342 45834 sl w0 0 ; if new key illegal then 21343 45836 sl w0 a110+1 ; 21344 45838 jl. j4. ; goto result 4; 21345 45840 21345 45840 g0: ; set key.work: 21346 45840 ; w0 = key 21347 45840 al w1 f51 ; 21348 45842 la. w1 d1.+f3 ; (leave first slice and namekey unchanged) 21349 45844 wa w1 0 ; 21350 45846 rs. w1 d1.+f3 ; key.work := key; 21351 45848 21351 45848 jl. n0. ; next instruction; 21352 45850 21352 45850 d10: 0 ; oldkey 21353 45852 21353 45852 21353 45852 21353 45852 ; restore oldkey 21354 45852 ; 21355 45852 ; key.work := oldkey 21356 45852 ; 21357 45852 ; call: m79 21358 45852 21358 45852 m79: ; restore oldkey: 21359 45852 am. (d10.) ; key := oldkey; 21360 45854 21360 45854 21360 45854 21360 45854 ; key.work := 0 21361 45854 ; 21362 45854 ; call: m80 21363 45854 21363 45854 m80: ; clear key.work: 21364 45854 al w0 0 ; key := 0; 21365 45856 jl. g0. ; goto set key.work; 21366 45858 21366 45858 e. ; 21367 45858 21367 45858 21367 45858 21367 45858 ; size.work := name table addr of area process 21368 45858 ; 21369 45858 ; call: m83 21370 45858 21370 45858 m83: ; set name table addr: 21371 45858 am. (d11.) ; size.work := cur proc name table addr; 21372 45860 21372 45860 21372 45860 21372 45860 ; size.work := 0 21373 45860 ; 21374 45860 ; call: m84 21375 45860 21375 45860 m84: ; clear size.work: 21376 45860 al w0 0 ; size.work := 0; 21377 45862 rs. w0 d1.+f7 ; 21378 45864 jl. n0. ; next instruction; 21379 45866 21379 45866 21379 45866 21379 45866 ; search bs-process and check reserved by sender 21380 45866 ; 21381 45866 ; the document, specified in docname.work must be a bs-device, 21382 45866 ; i.e. it must have base.proc = catalog interval. 21383 45866 ; it must be reserved by sender, because this will ensure, that 21384 45866 ; the document not already exists in the bs-system (otherwise 21385 45866 ; it would have been reserved by procfunc) 21386 45866 ; notice: chainhead.work is destroyed, but reinitialized 21387 45866 ; 21388 45866 ; call: m85, <not exist or not reserved addr> 21389 45866 ; error return: result 6, if document nameformat illegal 21390 45866 ; goto-action 1, if not reserved bs-device 21391 45866 ; return: cur proc name table addr is defined (i.e. the bs-device) 21392 45866 21392 45866 m85: ; check reserved bs-device: 21393 45866 al. w1 d1.+f5 ; 21394 45868 al w2 x1+f11-f5 ; move docname.work to name.work; 21395 45870 jl. w3 e32. ; 21396 45872 21396 45872 jl. w3 e24. ; test format; 21397 45874 jl. w3 e47. ; search best process in device-part of name table; 21398 45876 b4 ; (first device in name table) 21399 45878 b5 ; (top device in name table) 21400 45880 jl. n5. ;+6: not found: goto <not exist> 21401 45882 21401 45882 ; w0w1 = base.proc, w2 = proc 21402 45882 sn w0 (b45-2) ; if base.proc <> catalog interval then 21403 45884 se w1 (b45-0) ; 21404 45886 jl. n5. ; goto <not bs interval>; 21405 45888 21405 45888 rl. w1 d2. ; w1 := sender; 21406 45890 rl w0 x2+a52 ; w0 := reserver.proc; 21407 45892 se w0 (x1+a14) ; if sender is not reserver then 21408 45894 jl. n5. ; goto <not reserver>; 21409 45896 21409 45896 ; (move chainhead.sender to work, because name.work was destroyed above) 21410 45896 21410 45896 21410 45896 21410 45896 ; move chainhead.sender to work, if catsize <= 0 then goto <illegal catsize> 21411 45896 ; 21412 45896 ; (the catalog must have at least one catalog segment) 21413 45896 ; 21414 45896 ; call: m86, <illegal catsize addr> 21415 45896 ; error return: goto-action 1, if catsize illegal 21416 45896 21416 45896 m86: ; move chainhead to work, test catsize: 21417 45896 jl. w3 e92. ; move chainhead.sender to work; 21418 45898 21418 45898 21418 45898 21418 45898 ; if size <= 0 then goto <illegal catsize> 21419 45898 ; 21420 45898 ; call: m87, <illegal catsize addr> 21421 45898 ; error return: goto-action 1, if size <= 0 21422 45898 21422 45898 m87: ; test positive size: 21423 45898 am 1-0 ; minimum size := 1; 21424 45900 21424 45900 21424 45900 21424 45900 ; if size < 0 then goto <file descriptor> 21425 45900 ; 21426 45900 ; call: m88, <file descr addr> 21427 45900 ; error return: goto-action 1, if size < 0 21428 45900 21428 45900 m88: ; test size not negative: 21429 45900 al w0 0 ; minimum size := 0; 21430 45902 sh. w0 (d1.+f7); if size.work >= minimum size then 21431 45904 jl. n1. ; skip; 21432 45906 n1 = k-2 ; (stepping stone) 21433 45906 jl. n5. ; goto <illegal size or file descr>; 21434 45908 n5 = k-2 ; (stepping stone) 21435 45908 21435 45908 21435 45908 21435 45908 ; move tail and test new size 21436 45908 ; 21437 45908 ; if the old entry was a file-descriptor, it must still stay so 21438 45908 ; if the old entry was an area , it must still stay so 21439 45908 ; (i.e. the sign of size.work may not change) 21440 45908 ; 21441 45908 ; call: m89 21442 45908 ; error return: result 6, if illegal size-change 21443 45908 21443 45908 b. h10 w. 21444 45908 21444 45908 m89: ; move tail and test new size: 21445 45908 rl. w0 d1.+f7 ; 21446 45910 rs. w0 h0. ; old size := size.work; 21447 45912 21447 45912 jl. w3 m105. ; move tail.sender to tail.work; 21448 45914 21448 45914 rl. w0 d1.+f7 ; if sign (newsize) 21449 45916 lx. w0 h0. ; = sign (oldsize) then 21450 45918 sl w0 0 ; 21451 45920 jl. n0. ; next instruction; 21452 45922 21452 45922 jl. j6. ; goto result 6; (i.e. illegal size-change) 21453 45924 21453 45924 h0: 0 ; old size 21454 45926 21454 45926 e. ; 21455 45926 21455 45926 21455 45926 21455 45926 ; slice.work := 0 21456 45926 ; 21457 45926 ; call: m90 21458 45926 21458 45926 m90: ; clear first slice.work: 21459 45926 al w0 0 ; 21460 45928 hs. w0 d1.+f4 ; first slice.work := 0; 21461 45930 jl. n0. ; next instruction; 21462 45932 21462 45932 21462 45932 21462 45932 ; compute docnumber 21463 45932 ; 21464 45932 ; first slice.work := docnumber of curdoc 21465 45932 ; if old firstslice was neither 0 nor docnumber then error 21466 45932 ; 21467 45932 ; call: m91 21468 45932 ; exit: w2 = unchanged 21469 45932 ; error return: result 5, if illegal document-change 21470 45932 21470 45932 b. h10 w. 21471 45932 21471 45932 m91: ; compute docnumber: 21472 45932 rl. w1 d4. ; w1 := curdoc; 21473 45934 rl w1 x1+f60 ; docnumber := (claimsrel.curdoc 21474 45936 al w1 x1-a46 ; - start of claimrel) 21475 45938 al w0 0 ; / number of keys; 21476 45940 wd. w1 h0. ; 21477 45942 al w1 x1-2048 ; 21478 45944 bl. w0 d1.+f4 ; oldnumber := first slice.work; 21479 45946 hs. w1 d1.+f4 ; first slice.work := docnumber + auxcat-mark; 21480 45948 21480 45948 se w0 0 ; if only in maincat 21481 45950 sn w0 x1 ; or still in same auxcat then 21482 45952 jl. n0. ; next instruction; 21483 45954 21483 45954 jl. j5. ; goto result 5; (i.e. illegal document-change) 21484 45956 21484 45956 h0: a110 + 1 ; number of keys ( = max cat key + 1 ) 21485 45958 21485 45958 e. ; 21486 45958 21486 45958 21486 45958 21486 45958 21486 45958 ; the following set of routines all perform the different moves 21487 45958 ; between sender and procfunc: 21488 45958 ; 21489 45958 ; they all have a common call- and return-sequence: 21490 45958 ; 21491 45958 ; call: m<number> 21492 45958 21492 45958 m100:am e90-e95; move name.sender to name.work; 21493 45960 m101:am e95-e96; move name.work to name.sender; 21494 45962 m102:am e96-e70; move name.work + nametable address to name etc.sender 21495 45964 m103:am e70-e85; move newname.sender to/name.work; 21496 45966 m104:am e85-e72; move docname.sender to docname.work; 21497 45968 m105:am e72-e80; move tail.sender to tail.work; 21498 45970 m106:am e80-e73; move tail.work to tial.sender; 21499 45972 m107:am e73-e81; move entry.sender to entry.work; 21500 45974 m108:am e81-e92; move entry.work to entry.sender; 21501 45976 m109:am e92-e24; move chainhead.sender to entry.work; 21502 45978 jl. e24. ; 21503 45980 21503 45980 21503 45980 21503 45980 ; check any area processes 21504 45980 ; 21505 45980 ; all area processes are scanned, and it is tested that no internal 21506 45980 ; processes (except procfunc itself) are users of area processes 21507 45980 ; belonging to curdoc. (of course procfunc has a single one, the 21508 45980 ; auxcat area process). 21509 45980 ; notice that pseudo processes share the same area, but no process 21510 45980 ; can be user of a pseudo process 21511 45980 ; 21512 45980 ; call: m115 21513 45980 ; error return: result 5, if any processes has area processes on curdoc 21514 45980 21514 45980 b. g10 w. 21515 45980 21515 45980 m115: ; check area processes: 21516 45980 rl w2 b5 ; 21517 45982 al w2 x2-2 ; w2 := entry := base of area processes in nametable 21518 45984 g1: ; next area: 21519 45984 al w0 0 ; ( no users ) 21520 45986 g2: ; 21521 45986 al w2 x2+2 ; increase(entry); 21522 45988 sn w2 (b6) ; if all area processes tested then 21523 45990 jl. n0. ; next instruction; 21524 45992 21524 45992 rl w1 x2 ; proc := nametable(entry); 21525 45994 sn w0 (x1+a53) ; if users.proc = 0 then 21526 45996 jl. g2. ; goto next area; 21527 45998 21527 45998 ; an area process was found in use. 21528 45998 ; first test whether it is a file-descriptor-process or an area-process 21529 45998 21529 45998 rl w3 x1+a61 ; w3 := size.proc; 21530 46000 sh w3 -1 ; if size < 0 then 21531 46002 jl. g3. ; goto file-descriptor; 21532 46004 21532 46004 ; it was an area: test the document-name 21533 46004 rl. w3 d4. ; w3 := curdoc; 21534 46006 dl w0 x3+f61+2 ; 21535 46008 sn w3 (x1+a62+0) ; if docname.proc <> docname.curdoc then 21536 46010 se w0 (x1+a62+2) ; 21537 46012 jl. g1. ; goto next area; 21538 46014 rl. w3 d4. ; 21539 46016 dl w0 x3+f61+6 ; 21540 46018 sn w3 (x1+a62+4) ; 21541 46020 se w0 (x1+a62+6) ; 21542 46022 jl. g1. ; 21543 46024 21543 46024 ; the documentname corresponded to docname.curdoc. 21544 46024 ; procfunc is the only one allowed at this point 21545 46024 21545 46024 rl w3 b1 ; 21546 46026 rl w0 x3+a14 ; w0 := idbit.procfunc; 21547 46028 sn w0 (x1+a53) ; if users.proc = procfunc then 21548 46030 jl. g1. ; goto next area; 21549 46032 21549 46032 jl. j5. ; goto result 5; (i.e. other users) 21550 46034 21550 46034 g3: ; file-descriptor: 21551 46034 rl w3 x1+a60 ; w3 := first slice.proc; 21552 46036 sn w3 0 ; if first slice = 0 then 21553 46038 jl. g2. ; goto next area; (i.e. maincat entry) 21554 46040 21554 46040 am (b22) ; if docnumber (entry) <> docnumber (curdoc) then 21555 46042 rl w3 x3-2048 ; 21556 46044 se. w3 (d4.) ; 21557 46046 jl. g2. ; goto next area; 21558 46048 21558 46048 jl. j5. ; goto result 5; (i.e. entry in auxcat.curdoc) 21559 46050 21559 46050 e. ; 21560 46050 21560 46050 21560 46050 21560 46050 ; prepare catalog scan 21561 46050 ; 21562 46050 ; call: m116 21563 46050 21563 46050 m116: ; prepare catscan: 21564 46050 al w0 0 ; 21565 46052 rl. w2 d4. ; 21566 46054 hs w0 x2+f69 ; curkey.curdoc := 0; 21567 46056 jl. n0. ; next instruction; 21568 46058 21568 46058 21568 46058 21568 46058 ; test more catalog segments 21569 46058 ; 21570 46058 ; curkey is increased, and compared to size.maincat. 21571 46058 ; if more segments then goto ... 21572 46058 ; 21573 46058 ; call: m117, <more segments addr> 21574 46058 ; error return: goto-action 1, if more segments in main catalog 21575 46058 21575 46058 m117: ; test more catalog segments: 21576 46058 rl. w2 d4. ; 21577 46060 al w0 1 ; 21578 46062 ba w0 x2+f69 ; increase (curkey.curdoc); 21579 46064 hs w0 x2+f69 ; 21580 46066 21580 46066 rl. w2 d5. ; 21581 46068 se w0 (x2+f57) ; if curkey <> number of segments in maincat then 21582 46070 jl. n5. ; goto <more segments>; 21583 46072 jl. n1. ; skip; 21584 46074 21584 46074 21584 46074 21584 46074 ; for all curkey.curdoc entries do 21585 46074 ; 21586 46074 ; all entries, with key.entry = curkey, in main catalog are scanned 21587 46074 ; when all entries are examined then goto <no more>, else continue 21588 46074 ; 21589 46074 ; call: m118, <no more addr> 21590 46074 ; w2 = entry 21591 46074 ; ... 21592 46074 ; <actions for entries with key.entry = curkey> 21593 46074 ; ... 21594 46074 ; m119 21595 46074 ; 21596 46074 ; error return: result 2, if catalog io-error 21597 46074 ; goto-action 1, when no more entries to examine 21598 46074 21598 46074 b. g10, h10 w. 21599 46074 21599 46074 m118: ; for all curkey entries do: 21600 46074 al w0 0 ; 21601 46076 rs. w0 h0. ; entry-change := 0; 21602 46078 21602 46078 rl. w2 d4. ; w2 := curdoc; 21603 46080 bz w2 x2+f69 ; key := curkey.curdoc; 21604 46082 jl. w3 e14. ; for all key entries do 21605 46084 jl. n5. ;+2: no more: goto <no more>; 21606 46086 21606 46086 ; w2 = entry 21607 46086 ; w3 = continue search 21608 46086 rs. w2 h1. ; save (entry); 21609 46088 am n25-n35; call (second instruction); 21610 46090 n25 = k-2 ; (stepping stone) 21611 46090 21611 46090 21611 46090 21611 46090 ; endfor 21612 46090 ; 21613 46090 ; continues with the previous for-procedure 21614 46090 ; 21615 46090 ; call: m119 21616 46090 21616 46090 m119: ; endfor: 21617 46090 am n35-e14; goto return; 21618 46092 jl. e14. ; 21619 46094 21619 46094 21619 46094 21619 46094 ; multi-delete entry 21620 46094 ; 21621 46094 ; the current entry is deleted, and entrycount is prepared for later update 21622 46094 ; 21623 46094 ; call: w3 = return 21624 46094 ; m120 21625 46094 ; exit: w2 = entry address 21626 46094 21626 46094 m120: ; multi-delete entry: 21627 46094 rl. w2 h1. ; restore (entry); 21628 46096 al w0 -1 ; 21629 46098 rs w0 x2+f4 ; first word.entry := -1; 21630 46100 wa. w0 h0. ; 21631 46102 rs. w0 h0. ; decrease (entry count change); 21632 46104 jl. e9. ; prepare update 21633 46106 ; and return; 21634 46106 21634 46106 21634 46106 21634 46106 ; update entry-count 21635 46106 ; 21636 46106 ; in case any entries have been multi-deleted then the key-segment 21637 46106 ; will have its entry-count updated 21638 46106 ; 21639 46106 ; call: m121 21640 46106 ; error return: result 2, if catalog io-error 21641 46106 21641 46106 m121: ; update entry-count: 21642 46106 rl. w0 h0. ; 21643 46108 sn w0 0 ; if entry-count change = 0 then 21644 46110 jl. n0. ; next instruction; 21645 46112 21645 46112 rl. w2 d4. ; 21646 46114 bz w2 x2+f69 ; segment := curkey.curdoc; 21647 46116 jl. w3 e5. ; get catalog segment; 21648 46118 21648 46118 ; w2 = start of catalog buffer 21649 46118 rl. w0 h0. ; change entry count and prepare update; 21650 46120 jl. w3 e8. ; 21651 46122 21651 46122 jl. n0. ; next instruction; 21652 46124 21652 46124 h0 = d13 ; entry-count change 21653 46124 h1 = d14 ; entry 21654 46124 21654 46124 e. ; 21655 46124 21655 46124 21655 46124 21655 46124 ; check entry on document 21656 46124 ; 21657 46124 ; tests whether the current entry belongs to curdoc 21658 46124 ; 21659 46124 ; call: w2 = entry 21660 46124 ; m122, <not on doc addr> 21661 46124 ; error return: goto-action 1, if entry does not belong to curdoc 21662 46124 21662 46124 b. g10 w. 21663 46124 21663 46124 m122: ; check entry on document: 21664 46124 rl. w3 d4. ; w3 := curdoc; 21665 46126 rl w0 x2+f7 ; 21666 46128 sh w0 -1 ; if size.entry < 0 then 21667 46130 jl. g2. ; goto file-descriptor; 21668 46132 21668 46132 dl w1 x2+f11+2 ; 21669 46134 sn w0 (x3+f61+0) ; if docname.entry <> docname.curdoc then 21670 46136 se w1 (x3+f61+2) ; 21671 46138 jl. n5. ; goto <not on document>; 21672 46140 dl w1 x2+f11+6 ; 21673 46142 sn w0 (x3+f61+4) ; 21674 46144 se w1 (x3+f61+6) ; 21675 46146 jl. n5. ; 21676 46148 21676 46148 jl. n1. ; skip; 21677 46150 21677 46150 g2: ; file-descriptor: 21678 46150 bz w1 x2+f4 ; w1 := first slice.entry; 21679 46152 sn w1 0 ; if either maincat-entry 21680 46154 jl. n5. ; 21681 46156 am (b22) ; or docnumber.entry <> docnumber.curdoc then 21682 46158 se w3 (x1-2048) ; 21683 46160 jl. n5. ; goto <not on document>; 21684 46162 21684 46162 jl. n1. ; skip; 21685 46164 21685 46164 e. ; 21686 46164 21686 46164 21686 46164 21686 46164 ; for all existing chaintables do 21687 46164 ; 21688 46164 ; all chaintables, including maincat-pseudochain, are scanned. 21689 46164 ; when all tables are tested, then goto <no more>, else continue 21690 46164 ; 21691 46164 ; call: m123, <no more addr> 21692 46164 ; work = chainhead 21693 46164 ; w2 = work 21694 46164 ; ... 21695 46164 ; <actions for chaintable> 21696 46164 ; ... 21697 46164 ; m119 21698 46164 ; 21699 46164 ; error return: goto-action 1, when no more chaintables 21700 46164 21700 46164 b. g10, h10 w. 21701 46164 21701 46164 m123: ; for all existing chaintables do: 21702 46164 rl w1 b22 ; 21703 46166 al w1 x1-2 ; cur chain entry := base of chains in name table; 21704 46168 21704 46168 rl. w2 d5. ; chain := maincat pseudo chain; 21705 46170 21705 46170 g1: ; exit with chain: 21706 46170 rs. w1 h0. ; save (cur chain entry); 21707 46172 al w2 x2-f0 ; 21708 46174 al. w1 d1. ; move chainhead.chain to work; 21709 46176 jl. w3 e33. ; 21710 46178 21710 46178 al. w2 d1. ; w2 := work; 21711 46180 jl. w3 n25. ; call (second instruction); 21712 46182 21712 46182 ; when action m119 has been executed, then proceed here: 21713 46182 21713 46182 rl. w1 h0. ; restore (cur chain entry); 21714 46184 g2: ; next chain: 21715 46184 al w1 x1+2 ; increase (cur chain entry); 21716 46186 sn w1 (b24) ; if all chain are tested then 21717 46188 jl. n5. ; goto <no more>; 21718 46190 21718 46190 rl w2 x1 ; chain := name table (cur chain entry); 21719 46192 rl w3 x2+f61 ; 21720 46194 se w3 0 ; if docname(0).chain <> 0 then 21721 46196 jl. g1. ; goto exit with chain; i.e. chain exists 21722 46198 jl. g2. ; goto next chain; i.e. chain was idle; 21723 46200 21723 46200 h0 = d13 ; cur chain entry 21724 46200 21724 46200 e. ; 21725 46200 21725 46200 21725 46200 21725 46200 ; goto 21726 46200 ; 21727 46200 ; call: m125, <next address> 21728 46200 21728 46200 m125: ; goto: 21729 46200 jl. n5. ; goto <next address>; 21730 46202 21730 46202 21730 46202 21730 46202 ; return 21731 46202 ; 21732 46202 ; call: m126 21733 46202 21733 46202 m126: ; return: 21734 46202 am n30-n31; return; 21735 46204 21735 46204 21735 46204 21735 46204 ; skip-return 21736 46204 ; 21737 46204 ; call: m127 21738 46204 21738 46204 m127: ; skip-return: 21739 46204 am n31-n33; skip-return; 21740 46206 21740 46206 21740 46206 21740 46206 ; goto-return 21741 46206 ; 21742 46206 ; call: m128 21743 46206 21743 46206 m128: ; goto-return: 21744 46206 am -2048 ; 21745 46208 jl. n33.+2048; goto-return; 21746 46210 21746 46210 21746 46210 21746 46210 ; test devicenumber, user and reserver 21747 46210 ; 21748 46210 ; it is tested that the device number is legal, and that sender 21749 46210 ; is user of the device, and that no other processes are 21750 46210 ; reserver 21751 46210 ; 21752 46210 ; call: m149 21753 46210 ; error return: result 2, if sender is not user of the device 21754 46210 ; result 4, if illegal device number 21755 46210 ; result 5, if device reserved by another process 21756 46210 21756 46210 m149: ; test device,user,reserver: 21757 46210 rl. w1 d2. ; w1 := sender; 21758 46212 rl w2 x1+a29 ; devno := save w1.sender; 21759 46214 21759 46214 ls w2 1 ; entry := 2 * devno 21760 46216 wa w2 b4 ; + first device in name table; 21761 46218 sl w2 (b4) ; 21762 46220 sl w2 (b5) ; if entry is outside device-part of nametable then 21763 46222 jl. j4. ; result 4; (illegal device number); 21764 46224 21764 46224 rs. w2 d11. ; cur proc name table addr := entry; 21765 46226 21765 46226 rl w2 x2+0 ; proc := nametable(entry); 21766 46228 21766 46228 rl w0 x2+a53 ; w0 := users.proc; 21767 46230 so w0 (x1+a14) ; if sender is not user then 21768 46232 jl. j2. ; result 2; 21769 46234 j2 = k-2 ; (stepping stone) 21770 46234 21770 46234 rl w0 x1+a14 ; w0 := idbit.sender; 21771 46236 so w0 (x2+a52) ; if reserver.proc contains bits except idbit then 21772 46238 jl. j5. ; result 5; 21773 46240 21773 46240 jl. n0. ; next instruction; 21774 46242 21774 46242 21774 46242 21774 46242 ; set name and interval 21775 46242 ; 21776 46242 ; the curproc is initialized from base.work and name.work 21777 46242 ; 21778 46242 ; in case of magtape stations, the state.proc is set too, indicating 21779 46242 ; that the process is named 21780 46242 ; 21781 46242 ; call: m150 21782 46242 21782 46242 m150: ; set name and interval: 21783 46242 rl. w3 (d11.) ; w3 := proc; 21784 46244 al. w2 d1.+f5 ; w2 := name.work; 21785 46246 jd. 2 ;****** disable: 21786 46248 21786 46248 rl w1 x3+a10 ; w1 := kind.proc; 21787 46250 se w1 84 ; if kind = rcnet subprocess then 21788 46252 sn w1 85 ; 21789 46254 bz w1 x3+a63 ; kind := subkind.proc; 21790 46256 al w0 0 ; 21791 46258 sn w1 60 ; if magtape station then 21792 46260 rs w0 x3+a70 ; state.proc := named; 21793 46262 se w1 18 ; 21794 46264 sn w1 34 ; 21795 46266 rs w0 x3+a70 ; 21796 46268 21796 46268 dl w1 x2+f2-f5 ; base.proc := base.work; 21797 46270 ds w1 x3+a49 ; 21798 46272 21798 46272 al w1 x3+a11 ; w1 := name.proc; 21799 46274 jl. w3 e32. ; move name.work to name.proc; 21800 46276 21800 46276 je. n0. ;****** enable 21801 46278 ; next instruction; 21802 46278 21802 46278 21802 46278 21802 46278 21802 46278 21802 46278 ; create internal process 21803 46278 ; call: w1 = parameter address 21804 46278 ; w3 = name address 21805 46278 ; return: w0 = 0 ok 21806 46278 ; 1 storage,protection or claim trouble 21807 46278 ; 3 name overlap 21808 46278 ; 6 name illegal 21809 46278 ; parameters: 0 first core 21810 46278 ; 2 last core 21811 46278 ; 4 buf claim, area claim 21812 46278 ; 6 intern claim, func mask 21813 46278 ; 8 prot reg, prot key 21814 46278 ; 10-12 max interval 21815 46278 ; 14-16 stand interval 21816 46278 21816 46278 b.g10 21817 46278 w. 21818 46278 m151: ; create internal process: 21819 46278 rl. w1 d2. ; w1 := sender; 21820 46280 bz w0 x1+a21 ; if internal claim.sender = 0 21821 46282 sn w0 0 ; 21822 46284 jl. j1. ; then goto error 1 21823 46286 jl. w3 e76. ; move internal-params to work; 21824 46288 jl. w3 e44. ; find idle process; 21825 46290 b6 ;+2: (from internal processes) 21826 46292 al w1 x2+a27 ; index:= addr(ir addr.proc) 21827 46294 g1: rs w0 x1 ; proc descr(index):= 0 21828 46296 al w1 x1+2 ; index:= index+2 21829 46298 se w1 x2+a4-4 ; end until index = proc descr end 21830 46300 jl. g1. ; 21831 46302 al. w1 d1.+f6 ; 21832 46304 dl w0 x1+2 ; 21833 46306 la. w3 g6. ; 21834 46308 la. w0 g6. ; 21835 46310 ds w0 x2+a18 ; move first and last core 21836 46312 dl w0 x1+6 ; 21837 46314 ds w0 x2+a21 ; move claims and function mask 21838 46316 rl w3 x1+8 ; move protection reg and mask 21839 46318 rl. w0 c5. ; 21840 46320 ds w0 x2+a26 ; move interrupt mask 21841 46322 dl w0 x1+12 ; 21842 46324 ds w0 x2+a44 ; move max interval 21843 46326 dl w0 x1+16 ; 21844 46328 ds w0 x2+a45 ; move stand interval 21845 46330 ds w0 x2+a43 ; set catalog base 21846 46332 rl. w1 d2. ; w1 := sender 21847 46334 dl w0 x2+a44 ; test max base: 21848 46336 sh w0 x3-1 ; if lower.max.proc > upper.max.proc 21849 46338 jl. j1. ; then goto error 1 21850 46340 bs. w0 1 ; 21851 46342 sl w3 (x1+a44-2; if lower.max.proc < lower.max.sender 21852 46344 sl w0 (x1+a44) ; or upper.max.proc > upper.max.sender 21853 46346 jl. j1. ; then goto error 1 21854 46348 dl w0 x2+a45 ; test standard base: 21855 46350 sh w0 x3-1 ; 21856 46352 jl. j1. ; 21857 46354 bs. w0 1 ; 21858 46356 sl w3 (x1+a45-2; 21859 46358 sl w0 (x1+a45) ; 21860 46360 jl. j1. ; 21861 46362 21861 46362 dl w0 x1+a182 ; initial,current (cpa, base) (child) 21862 46364 ds w0 x2+a172 ; := current cpa,base (sender); 21863 46366 ds w0 x2+a182 ; 21864 46368 21864 46368 ; the following is just an ad hoc solution for determining the writing priviliges: 21865 46368 bz w0 x2+a25 ; if pk(child) = 0 then 21866 46370 se w0 0 ; begin 21867 46372 jl. g8. ; 21868 46374 21868 46374 al w3 8 ; lower write limit := 8; 21869 46376 rl w0 b12 ; top write limit := core size; 21870 46378 rl. w1 g10. ; interrupt levels := standard; 21871 46380 jl. g9. ; end 21872 46382 g8: ; else begin 21873 46382 dl w0 x2+a18 ; lower write limit := first of process + base; 21874 46384 wa w3 x2+a182 ; top write limit := top of process + base; 21875 46386 wa w0 x2+a182 ; 21876 46388 sh w0 x3 ; if base is so extreme that process wraps around then 21877 46390 je. j1. ; goto result 1; 21878 46392 sh w0 (b12) ; if limits gets outside relevant part of core then 21879 46394 sh w3 8-1 ; 21880 46396 je. j1. ; goto result 1; 21881 46398 21881 46398 rl w1 x1+a185 ; interrupt levels := current interrupt levels(sender); 21882 46400 g9: ; end; 21883 46400 ds w0 x2+a184 ; initial,current write-limits := limits; 21884 46402 ds w0 x2+a174 ; 21885 46404 rs w1 x2+a185 ; initial,current interrupt levels := interrupt levels; 21886 46406 rs w1 x2+a175 ; 21887 46408 21887 46408 rl. w1 d2. ; restore sender; 21888 46410 21888 46410 rl w3 x1+a22 ; 21889 46412 bz w0 x2+a22 ; if function mask.proc 21890 46414 so w3 (0) ; is not subset of mask.sender 21891 46416 jl. j1. ; then goto error 1 21892 46418 c.-4000 21893 46418 rl w0 x2+a24 ; 21894 46418 sz. w0 (g5.) ; if pk.proc > 7 or pr.proc > 255 21895 46418 jl. j1. ; then goto error 1 21896 46418 bz w3 x1+a25 ; 21897 46418 sn w3 0 ; if pk.sender <> 0 21898 46418 jl. g2. ; then begin 21899 46418 bz w3 1 ; 21900 46418 ls w0 x3+4 ; 21901 46418 al w3 2.111 ; 21902 46418 lo w3 x2+a24 ; 21903 46418 sl w0 0 ; if bit(pk.proc)in:(pr.proc)<> 0 21904 46418 so w3 (x1+a24) ; or pr.proc not subset pr.sender 21905 46418 jl. j1. ; then goto error 1 end 21906 46418 z. 21907 46418 g2: dl w0 x2+a18 ; 21908 46420 sl w3 (x1+a17) ; if first core.proc < first core.sender 21909 46422 sh w0 x3 ; or last core.proc <= first core.proc 21910 46424 jl. j1. ; then goto error 1 21911 46426 sh w0 (x1+a18) ; if last core.proc > last core.sender 21912 46428 jd. g3. ; 21913 46430 jl. j1. ; then goto error 1 21914 46432 g3: rs w3 x2+a33 ; ic.proc:=first core.proc 21915 46434 rl w3 x2+a19 ; 21916 46436 sz. w3 (c4.) ; 21917 46438 je. j1.,j1=k-2; 21918 46440 bl w3 x2+a21 ; 21919 46442 sh w3 -1 ; 21920 46444 je. j1. ; 21921 46446 rl w0 x1+a19 ; if buf claim > buf claim.sender 21922 46448 ws w0 x2+a19 ; or area claim.proc > area claim.sender 21923 46450 ac w3 x3+1 ; or int claim proc > int claim.sender-1 21924 46452 ba w3 x1+a21 ; then goto error 1 21925 46454 sl w3 0 ; 21926 46456 sz. w0 (c4.) ; 21927 46458 je. j1. ; 21928 46460 hs w3 x1+a21 ; set internal claim.sender 21929 46462 rs w0 x1+a19 ; set buf and area claim.sender 21930 46464 rs w1 x2+a34 ; parent.proc:= sender 21931 46466 dl w0 b13+2 ; 21932 46468 ds w0 x2+a38+2; start run.proc:= time 21933 46470 al w0 f47 ; stop count.proc:= 0 21934 46472 rs w0 x2+a13 ; state.proc:= wait start parent 21935 46474 al w0 0 ; save area.proc := 0; 21936 46476 rs w0 x2+a302 ; 21937 46478 rl w0 x1+a301 ; priority.proc := priority.sender; 21938 46480 rs w0 x2+a301 ; 21939 46482 jl. n0. ; goto next instruction 21940 46484 g5: 8.7400 7770 ; 21941 46486 g6: 8.7777 7776 ; 21942 46488 g10: 6 < 12 + b54 ; standard interrupt levels, used by drivers etc 21943 46490 e. ; 21944 46490 21944 46490 21944 46490 ; start internal process(name); 21945 46490 ; follows the process tree starting with the process given by name.work 21946 46490 ; which must be a child of the sender (otherwise: error 3); if the state 21947 46490 ; of the child is not waiting for start by parent nothing will be done at all. 21948 46490 ; if ok then the child and all the decendants with state = waiting for 21949 46490 ; for start by ancestor found by following the tree are treated as follows: 21950 46490 ; the protection key is set on the whole process area, the description 21951 46490 ; address of the processes are chained together via wait address with end 21952 46490 ; chain holding the address of the last process. 21953 46490 ; when the tree is exhausted then the chain is followed in disabled mode 21954 46490 ; and each process is entered in the timer queue, its state is set to run- 21955 46490 ; ning and stop count for its parent is increased by one. 21956 46490 21956 46490 b. g5 ; begin 21957 46490 w. ; start internal process: 21958 46490 21958 46490 m152: ; 21959 46490 jl. w3 e17. ; first proc (proc addr, new state); 21960 46492 21960 46492 g0: bz w0 x3+a13 ; treat next: disable; 21961 46494 se w0 x2+f41 ; if state.proc addr = new state + no stop bit 21962 46496 jl. g1. ; then begin enable; 21963 46498 c.-8000-(:a128>2a.1:) 21964 46498 bz w0 x3+a25 ; set pk (proc addr, pk.proc addr); 21965 46498 je. w2 e22. ; w2 link; chain and add children; 21966 46498 z. jl. w3 e18. ; end; 21967 46500 21967 46500 g1: je. w3 e20. ; next process; 21968 46502 jd. g0. ; if more then goto treat next; 21969 46504 ; tree exhausted. now start all the processes: 21970 46504 21970 46504 rl. w3 d13.+4 ; proc := end chain; 21971 46506 jd 1<11+58 ; start the whole chain; (special instruction) 21972 46508 jl. (2), j0 ; goto exit ok; 21973 46512 j0 = k-4 ; stepping stone 21974 46512 21974 46512 e. ; end start internal process; 21975 46512 21975 46512 ; stop internal process (name,buf,result); 21976 46512 ; follows the process tree, starting with the process given by name. 21977 46512 ; work, of those processes which are not waiting for stop or already 21978 46512 ; stopped. 21979 46512 ; each of these processes is treated, in disabled mode, as follows: 21980 46512 ; if it is in a queue then it is removed from that queue, 21981 46512 ; if it is in a waiting state then the instruction counter is decreased 21982 46512 ; by 2 so that the original monitor call will be repeated when it is 21983 46512 ; restarted. 21984 46512 ; if stop count is zero then the state is set to: if the process is 21985 46512 ; the direct child of the sender, i.e. the first process treated, then 21986 46512 ; wait start by parent, else wait start by ancestor; and stop count 21987 46512 ; for the parent is decreased by one, possibly stopping the parent. 21988 46512 ; if stop count is not zero then state is set to wait stop by parent 21989 46512 ; or wait stop by ancestor as above. 21990 46512 ; when the states of all the processess involved are set, the stop count 21991 46512 ; of the process given by name.work is inspected. if the count is zero, thus 21992 46512 ; indicating that the processes are effectively stopped, then a normal answer 21993 46512 ; (result = 1) is send to the calling process. 21994 46512 21994 46512 b. g5 ; begin 21995 46512 w. ; stop internal process: 21996 46512 21996 46512 m153: ; 21997 46512 jl. w3 e17. ; first proc (proc addr, new state); 21998 46514 ds. w3 d16.+2 ; save (new state, proc); 21999 46516 21999 46516 ; prepare the message buffer for returning the answer 22000 46516 bz w0 x1+a19 ; decrease(bufclaim(sender)); 22001 46518 bs. w0 1 ; (it has already been tested that 22002 46520 hs w0 x1+a19 ; the claim is present). 22003 46522 22003 46522 rl w2 b8 ; buf := next(mess buf pool); 22004 46524 jl w3 b35 ; remove(buf); 22005 46526 22005 46526 ac w0 (b1) ; receiver(buf) := -procfunc; i.e. let procfunc claim it. 22006 46528 ds w1 x2+6 ; sender(buf) := sender; 22007 46530 rl w0 x1+a30 ; 22008 46532 rs w0 x2+a139 ; mess.flag=saved w2 22009 46534 22009 46534 rs w2 x1+a30 ; save w2(sender) := buf; 22010 46536 22010 46536 rl. w3 d16.+2 ; w3 := proc; 22011 46538 rs w2 x3+a40 ; 22012 46540 rl. w2 d16. ; w2 := new state; 22013 46542 22013 46542 g0: bz w0 x3+a13 ; treat next: disable; 22014 46544 sz w0 f43 ; state.w0:= state.proc; 22015 46546 jl. g3. ; if -, stopped bit (state.w0) then 22016 46548 22016 46548 hs w2 x3+a13 ; begin 22017 46550 rl w2 x3+a33 ; state.proc:= new state; 22018 46552 al w2 x2-2 ; if repeat bit (state.w0) then 22019 46554 sz w0 f40 ; ic.proc:= ic.proc - 2; 22020 46556 rs w2 x3+a33 ; 22021 46558 22021 46558 al w2 x3+a16 ; 22022 46560 sz w0 f44 ; if out of queue bit (state.w0) 22023 46562 jd w3 b35 ; then remove (proc); 22024 46564 al w3 x2-a16 ; 22025 46566 22025 46566 g1: rl w2 x3+a12 ; loop stop: 22026 46568 sz. w2 (c7.) ; if stop count.proc = 0 and 22027 46570 jl. g2. ; -, no stop bit (state.proc) then 22028 46572 22028 46572 al w2 x2+f41 ; begin 22029 46574 hs w2 x3+a13 ; state.proc:= state.proc + no stop bit; 22030 46576 rl w3 x3+a34 ; proc:= parent.proc; 22031 46578 bz w2 x3+a12 ; stop count.proc:= 22032 46580 al w2 x2-1 ; stop count.proc - 1; 22033 46582 hs w2 x3+a12 ; goto loop stop; 22034 46584 jl. g1. ; end; 22035 46586 22035 46586 g2: jl. w3 e19. ; add children; 22036 46588 sn w0 0 ; if children bits=0 22037 46590 jl. g4. ; then goto no more; 22038 46592 ; end; 22039 46592 22039 46592 g3: je. w3 e20. ; enable; next proc (proc, newstate); 22040 46594 jd. g0. ; if more then goto treat next; 22041 46596 g4: rl. w3 d16.+2 ; no more:unsave proc; 22042 46598 c.-8000-(:a128>2a.1:) 22043 46598 rl. w2 d2. ; 22044 46598 bz w0 x2+a25 ; 22045 46598 je. w2 e22. ; w2 link ; set pk (proc,pk.parent); 22046 46598 z. jd. 2 ; 22047 46600 al. w1 d16. ; if stop count.proc = 0 then 22048 46602 rl w2 x3+a40 ; send answer (answ addr, 22049 46604 bz w0 x3+a12 ; wait addr.proc,1); 22050 46606 ac w3 (b1) ; 22051 46608 sn w0 0 ; if stopcount <> 0 22052 46610 se w3 (x2+4) ; or procfunc not receiver anymore 22053 46612 ; i.e. a driver may have used ...decrease stopcount... 22054 46612 je. j0. ; then goto exit ok 22055 46614 ac w3 x3+0 ; 22056 46616 bz w0 x3+a19 ; bufclaim.procfunc 22057 46618 bs. w0 1 ; - 1 22058 46620 hs w0 x3+a19 ; =: bufclaim.procfunc 22059 46622 al w0 1 ; 22060 46624 jd 1<11+22 ; send answer 22061 46626 je. j0. ; goto exit ok 22062 46628 22062 46628 e. ; end stop internal process; 22063 46628 22063 46628 ; modify internal process (name,registers); 22064 46628 ; finds the process given by name.work and checks that it is a child of 22065 46628 ; the sender. if the process is waiting for start by parent then the 22066 46628 ; given values of the registers and the instruction counter are set in 22067 46628 ; the process description. 22068 46628 22068 46628 b. g5 ; begin 22069 46628 w. ; modify internal process: 22070 46628 22070 46628 m154: ; 22071 46628 jl. w3 e17. ; first proc (proc addr,new state); 22072 46630 bz w0 x3+a13 ; disable; 22073 46632 se w0 f47 ; if state.proc <> waiting for start by parent 22074 46634 je. j2.,j2=k-2 ; then goto enabled error2; 22075 46636 22075 46636 rl w0 x3+a33 ; if save ic(child) odd then 22076 46638 so w0 2.1 ; begin 22077 46640 jl. g0. ; (it waited for completion of initialize process etc) 22078 46642 22078 46642 ; search through the message pool to find the corresponding buffer: 22079 46642 rl w2 b8+4 ; buf := first mess buf 22080 46644 ws w2 b8+8 ; - buf size; 22081 46646 22081 46646 g1: wa w2 b8+8 ; rep: if buf >= last of pool then 22082 46648 sl w2 (b8+6) ; goto result 2; 22083 46650 je. j2. ; (it should be a severe error) 22084 46652 22084 46652 se w3 (x2+6) ; if child <> sender(buf) or 22085 46654 jl. g1. ; 22086 46656 rl w1 x2+4 ; receiver(buf) > 0 or 22087 46658 sh w1 0 ; receiver(buf) is even then 22088 46660 so w1 2.1 ; 22089 46662 jl. g1. ; goto rep; 22090 46664 22090 46664 al w1 x1+1 ; make receiver(buf) even; 22091 46666 rs w1 x2+4 ; 22092 46668 al w1 x3 ; (save child) 22093 46670 jl w3 b43 ; regretted message(buf); 22094 46672 al w3 x1 ; (restore child) 22095 46674 ; end; 22096 46674 22096 46674 g0: ; 22097 46674 je. w3 e74. ; ** enable and ** move registers to tail.work; 22098 46676 rl. w1 d14. ; w1 := child; 22099 46678 am -2048 ; 22100 46680 al. w2 v6.+2048 ; w2 := register area; 22101 46682 22101 46682 al w0 -1<1 ; 22102 46684 la w0 x2-a28+a33; make child ic even; 22103 46686 rs w0 x2-a28+a33; 22104 46688 22104 46688 sl w0 (x1+a17) ; if child ic outside 22105 46690 sl w0 (x1+a18) ; child process then 22106 46692 jl. j2. ; goto result 2; 22107 46694 22107 46694 rl. w3 d2. ; w3 := sender; (i.e. parent process) 22108 46696 rl w0 x3+a32 ; new status := 22109 46698 lo. w0 g3. ; monmode.sender 22110 46700 la w0 x2-a28+a32; and monmode.new status 22111 46702 la. w0 g4. ; or exceptionbits.new status 22112 46704 22112 46704 rl w3 x1+a32 ; 22113 46706 la. w3 g5. ; or aritmetic interrupts.status.child; 22114 46708 lo w3 0 ; 22115 46710 22115 46710 rs w3 x2-a28+a32; status.child := new status; 22116 46712 22116 46712 al w0 12 ; 22117 46714 al w1 x1+a28 ; 22118 46716 jl. w3 e31. ; move registers to child description; 22119 46718 22119 46718 jl. j0. ; return ok; 22120 46720 22120 46720 g3: 2.111 ; exception 22121 46722 g4: 1<23+2.111 ; monitor mode + exception 22122 46724 g5: 2.11<18 ; aritmetic interrupts 22123 46726 e. ; end modify internal process; 22124 46726 22124 46726 ; remove process (name); 22125 46726 ; area process: the sender is removed as user and reserver of the 22126 46726 ; process, possibly removing the area process (see procedure clear 22127 46726 ; area proc). 22128 46726 ; peripheral process: if the sender is allowed to call the function 22129 46726 ; the peripheral process is removed if it is not reserved by another 22130 46726 ; process. 22131 46726 ; internal process: if the process is a child of the sender and is 22132 46726 ; waiting for start by parent then 22133 46726 ; 1* the protection key is reset in the process area, 22134 46726 ; 2* the process is removed, 22135 46726 ; 3* the process is removed from all external processes, 22136 46726 ; 4* all message buffers involving the removed process are cleaned 22137 46726 ; up, so that the buffers may return to the pool, 22138 46726 ; 5* all console buffers involving the removed process are released. 22139 46726 ; 2* to 5* is applied to all descendants of the child in a recursive 22140 46726 ; way. 22141 46726 22141 46726 b. g25 ; begin 22142 46726 w. ; remove process: 22143 46726 22143 46726 m155:jl. w3 e47. ; search best process in name table; 22144 46728 b3 ; (first in name table) 22145 46730 b7 ; (top of name table) 22146 46732 jl. e26. ;+6: not found: goto test found; 22147 46734 al w3 x2 ; proc := proc found; 22148 46736 al. w2 j0. ; return to ex ok; 22149 46738 22149 46738 rl w0 x3+a10 ; get and examine kind: 22150 46740 rl. w1 d2. ; w1 := sender; 22151 46742 sn w0 f38 ; if kind.proc = area kind then 22152 46744 jd. w0 e25. ; w2 link ; remove area (sender,proc); 22153 46746 sn w0 f37 ; if kind.proc = internal kind then 22154 46748 je. g1. ; enabled goto internal; 22155 46750 sn w0 64 ; if kind.proc = pseudo kind then 22156 46752 jl. g0. ; goto pseudo process; 22157 46754 ; peripheral process: 22158 46754 bl w0 x1+a22 ; w0 := function mask.sender; 22159 46756 so w0 f75 ; if function not allowed then 22160 46758 je. j1. ; enabled result 1; 22161 46760 rl w0 x1+a14 ; if sender not user of process 22162 46762 sz w0 (x3+a53) ; then enabled goto error 2; 22163 46764 jl. 4 ; 22164 46766 je. j2. ; 22165 46768 lo w0 x3+a52 ; if reserved by other then 22166 46770 se w0 (x1+a14) ; enabled goto error5; 22167 46772 je. j5.,j5=k-2 ; 22168 46774 al w0 0 ; name(0).proc:= 0; 22169 46776 rs w0 x3+a11 ; comment: now removed; 22170 46778 rs w0 x3+a52 ; reserved.proc:= 0; 22171 46780 jl. w2 g7. ; release process; 22172 46782 je. j0. ; enabled goto ex ok; 22173 46784 22173 46784 g0: ; pseudo process: 22174 46784 se w1 (x3+a50) ; if sender <> mainproc.pseudo process then 22175 46786 je. j3. ; goto result 3; 22176 46788 22176 46788 rs. w3 g24. ; save (pseudo process); 22177 46790 g21: ; scan all: 22178 46790 rl w1 b8+4 ; w1 := first message buffer; 22179 46792 rl. w3 g24. ; w3 := pseudo process; 22180 46794 ac w2 x3 ; (w2 := claimed buffer) 22181 46796 jd. g23. ; goto examine buffer; 22182 46798 g25: ; regret: 22183 46798 al w2 x1 ; 22184 46800 jd w3 b43 ; regretted message(buf); 22185 46802 je. g21. ; goto scan all; 22186 46804 22186 46804 g22: ; buffer in queue: 22187 46804 rl. w2 d2. ; w2 := sender; 22188 46806 jl. w3 g12. ; clean to (buffer, sender); 22189 46808 je. g21. ; goto scan all; 22190 46810 22190 46810 g23: ; examine buffer: 22191 46810 sn w3 (x1+a141) ; if receiver.buf = proc then 22192 46812 jl. g22. ; goto buffer in queue; 22193 46814 sn w2 (x1+a141) ; if buffer claimed by proc then 22194 46816 je. j2. ; goto result 2; 22195 46818 sn w3 (x1+a142) ; if sender.buf = proc 22196 46820 jl. g25. ; then goto regret; 22197 46822 wa w1 b8+8 ; buffer := next buffer in pool; 22198 46824 sh w1 (b8+6) ; if not all buffers tested then 22199 46826 jl. g23. ; goto examine buffer; 22200 46828 22200 46828 rl. w1 d2. ; 22201 46830 al w0 0 ; 22202 46832 rs w0 x3+a11 ; name(0).proc := 0; 22203 46834 rs w0 x3+a50 ; mainproc.proc := 0; 22204 46836 bz w2 x1+a23 ; 22205 46838 al w2 x2+1 ; increase (pseudo claim.sender); 22206 46840 hs w2 x1+a23 ; 22207 46842 22207 46842 je. j0. ; goto result ok; 22208 46844 22208 46844 g24: 0 ; saved pseudo process , work 22209 46846 22209 46846 g1: ; internal: 22210 46846 jl. w3 e17. ; first proc (proc addr,--); 22211 46848 bz w0 x3+a13 ; if not child then goto error 3; 22212 46850 se w0 f47 ; if state.proc <> wait start by parent 22213 46852 je. j2.,j2=k-2 ; then goto error 2; 22214 46854 22214 46854 g5: jd. w3 e18. ; link: chain and add children; 22215 46856 je. w3 e20. ; next proc (proc addr,--); 22216 46858 jd. g5. ; if more then disabled goto link; 22217 46860 22217 46860 rl. w3 d15. ; tree exhausted: proc:= end chain; 22218 46862 22218 46862 g6: al w0 0 ; used ; remove one process: 22219 46864 rs w0 x3+a11 ; name(0).proc:= 0; 22220 46866 ac w2 x3+0 ; childrenbits:= -proc; 22221 46868 ds. w3 d14. ; proc addr:= proc; 22222 46870 22222 46870 rl w3 b4 ; extproc:= first device in name table; 22223 46872 g2: rs. w3 g24. ; examine extproc: 22224 46874 rl. w1 d14. ; 22225 46876 rl w3 x3+0 ; if kind.extproc = area kind 22226 46878 rl w0 x3+a10 ; then disable: 22227 46880 sn w0 64 ; if kind.extproc = pseudoproc 22228 46882 se w1 (x3+a50) ; and mainproc.extproc = proc 22229 46884 jl. g15. ; then begin 22230 46886 al w0 0 ; 22231 46888 rs w0 x3+a11 ; name.extproc:= 0 22232 46890 je. g4. ; 22233 46892 g15: sn w0 f38 ; remove area (proc,extproc); 22234 46894 jd. w2 e25. ; w2 link ; enable: 22235 46896 rl w2 x1+a14 ; users(id bit.proc).extproc:= 0; 22236 46898 ac w0 x2+1 ; res(id bit,proc).extproc:= 0; 22237 46900 la w0 x3+a53 ; 22238 46902 rs w0 x3+a53 ; comment: proc is removed as 22239 46904 la w0 x3+a52 ; user and as reserver of 22240 46906 rs w0 x3+a52 ; extproc; 22241 46908 rl w0 x3+a53 ; 22242 46910 sn w0 0 ; if users=0 then 22243 46912 jl. w2 g7. ; release process; 22244 46914 22244 46914 g4: rl. w3 g24. ; extproc:= next proc in name table; 22245 46916 al w3 x3+2 ; if extproc <> first intproc 22246 46918 se w3 (b6) ; then goto 22247 46920 je. g2. ; examine extproc; 22248 46922 22248 46922 rl w1 b8+4 ; examine message buffers: 22249 46924 g10: jd. 2 22250 46926 dl w3 x1+6 ; for buf:= first mess buf 22251 46928 sh w2 0 ; 22252 46930 ac w2 x2 ; 22253 46932 rl w0 x2+a10 ; 22254 46934 sn w0 64 ; if receiver = pseudoproc 22255 46936 rl w2 x2+a50 ; then receiver:= mainproc.reciever 22256 46938 sh w3 0 ; if sender = pseudoproc 22257 46940 ac w3 x3 ; then sender:= mainproc.sender 22258 46942 rl w0 x3+a10 ; 22259 46944 sn w0 64 ; 22260 46946 rl w3 x3+a50 ; 22261 46948 ; step buf size 22262 46948 sn. w2 (d13.+2) ; until last mess buf do 22263 46950 jl. w3 g12. ; begin 22264 46952 ; if proc = abs (receiver.buf) 22265 46952 sn. w3 (d13.+2) ; then clean to (buf); 22266 46954 jd. g13. ; if proc = abs (sender.buf) 22267 46956 g11: wa w1 b8+8 ; then clean from (buf); 22268 46958 sh w1 (b8+6) ; end; 22269 46960 je. g10. ; 22270 46962 al w0 0 ; 22271 46964 rl. w3 d14. ; 22272 46966 rl w1 b5 ; for pseudoproc:=first pseudoproc in name table 22273 46968 g19: jd. 2 ; step 2 until 22274 46970 rl w2 x1+0 ; first internal in name table do 22275 46972 se w3 (x2+a50) ; begin 22276 46974 jl. g20. ; if proc=mainproc.proc 22277 46976 rs w0 x2+a50 ; then 22278 46978 bz w2 x3+a23 ; begin 22279 46980 al w2 x2+1 ; mainproc.proc:=0; 22280 46982 hs w2 x3+a23 ; pseudoclaims.proc:= 22281 46984 g20: al w1 x1+2 ; pseudoclaims.proc+1; 22282 46986 se w1 (b6) ; end 22283 46988 je. g19. ; end 22284 46990 g16: jd. 2 ; add claims: disable 22285 46992 al w2 0 ; 22286 46994 rl. w3 d14. ; 22287 46996 dl w1 x3+a21 ; 22288 46998 rx w2 x3+a34 ; claims.parent.proc:= 22289 47000 hl. w1 g6.+1 ; note ; claims.parent.proc + claim.proc; 22290 47002 aa w1 x2+a21 ; add one to int claim.parent.proc; 22291 47004 wa. w1 c8. ; parent.proc:= 0; 22292 47006 ds w1 x2+a21 ; proc:= wait addr.proc; 22293 47008 dl w1 x3+a36+2 ; runtime(parent) := 22294 47010 aa w1 x2+a36+2 ; runtime(parent) + 22295 47012 ds w1 x2+a36+2 ; runtime(child); 22296 47014 al w1 x3+a46 ; claims child 22297 47016 al w2 x2+a46 ; claims parent 22298 47018 g17: rl w0 x2 ; claims parant(i) 22299 47020 wa w0 x1 ; + claims child(i) 22300 47022 rs w0 x2 ; =:claims parent(i) 22301 47024 al w1 x1+2 ; 22302 47026 al w2 x2+2 ; i:= i+1 22303 47028 se w1 x3+a4-4 ; if i<procdescr end 22304 47030 jl. g17. ; then goto repeat 22305 47032 rl w3 x3+f26 ; if proc <> 0 then enabled 22306 47034 se w3 0 ; goto remove one process else 22307 47036 je. g6. ; enabled goto ex ok; 22308 47038 je. j0. ; 22309 47040 ; end remove process; 22310 47040 22310 47040 c4: 3<22 + 3<10 ; used to test claims 22311 47042 c5: a89 ; initial interrupt mask 22312 47044 c7: -1<12 + f41 ; used by stop internal 22313 47046 c8: 1<12 + 0 ; 22314 47048 22314 47048 ; release process. 22315 47048 ; this procedure releases an external process if it is of 22316 47048 ; type remote subprocess (monitor kind=85). 22317 47048 ; call: return: 22318 47048 ; w0 destroyed 22319 47048 ; w1 destroyed 22320 47048 ; w2 link destroyed 22321 47048 ; w3 proc destroyed 22322 47048 b.i10 w. 22323 47048 g7: rl w0 x3+a10 ; release process: 22324 47050 se w0 85 ; if kind<>85 then 22325 47052 jl x2 ; return; 22326 47054 ds. w3 i2. ; 22327 47056 al. w1 i0. ; message:=release; 22328 47058 al. w3 i3. ; name:=<:host:>; 22329 47060 jd 1<11+16 ; send message; 22330 47062 rl. w1 i4. ; 22331 47064 jd 1<11+18 ; wait answer; 22332 47066 jl. (i1.) ; exit: return; 22333 47068 22333 47068 i0: 2<12+1 ; message: operation:=release, mode:=indirect addr; 22334 47070 i4: d16 ; dummy (answer area address) 22335 47072 i1: 0 ; dummy (saved return addr) 22336 47074 i2: 0 ; i0+6 ; proc 22337 47076 22337 47076 i3: <:host:>,0,0,0 ; name-constant and name table addr 22338 47086 22338 47086 e. 22339 47086 22339 47086 ; the following three procedures (used by remove process) are called in 22340 47086 ; disabled mode but returns enabled 22341 47086 22341 47086 ; procedure clean to (buf); 22342 47086 ; delivers a dummy answer <receiver does not exist> in the queue of 22343 47086 ; the sending process (the buffer administration takes care if the 22344 47086 ; sender is removed). 22345 47086 g12: rs. w3 g14. ; save (return); 22346 47088 rl w3 b1 ; 22347 47090 bz w0 x3+a19 ; bufclaim.procfunc 22348 47092 bs. w0 1 ; -1 22349 47094 hs w0 x3+a19 ; =: bufclaim.procfunc 22350 47096 ac w3 x3 ; 22351 47098 rx w3 x1+4 ; sender.buf:= -procfunc 22352 47100 bz w0 x2+a19 ; bufclaim.sender 22353 47102 sh w3 0 ; + if buffer received 22354 47104 ba. w0 1 ; then 1 else 0 22355 47106 hs w0 x2+a19 ; =: bufclaim.semder 22356 47108 al w2 x1 ; 22357 47110 jl w3 b44 ; remove(buf) 22358 47112 al. w1 0 ; here ; 22359 47114 al w0 5 ; 22360 47116 jd 1<11+22 ; send answer(5,answer addr,buf) 22361 47118 al w1 x2 ; 22362 47120 dl w3 x1+6 ; 22363 47122 jd. (g14.) ; 22364 47124 22364 47124 g14: 0 ; saved return 22365 47126 22365 47126 ; procedure clean from (buf); 22366 47126 ; releases pending buffers and prepares the return of buffer claims to 22367 47126 ; the parents of removed processes. 22368 47126 g13: al w2 x1 ; 22369 47128 jd w3 b43 ; regretted message (buf); 22370 47130 je. g11. ; 22371 47132 e. 22372 47132 22372 47132 22372 47132 22372 47132 ; copy message 22373 47132 ; 22374 47132 ; call: m156 22375 47132 ; error return: result 2, if sender.buf is stopped 22376 47132 ; result 3, if message regretted 22377 47132 ; result 3, if addresses.buffer illegal 22378 47132 ; result 3, if operation.buffer neither input nor output 22379 47132 22379 47132 b. g10, h10 w. 22380 47132 22380 47132 m156: ; copy message: 22381 47132 rl. w1 (d20.) ; w1 := sender; 22382 47134 rl w3 x1+a30 ; w3 := buf := save w2.sender; 22383 47136 rl w2 x3+6 ; w2 := sender.buf; 22384 47138 sh w2 -1 ; if sender.buf < 0 then 22385 47140 jl. j3. ; result 3; i.e. message regretted; 22386 47142 rl w0 x2+a10 ; if sender.buf is a pseudo process 22387 47144 sn w0 64 ; then sender.buf:= main(sender.buf); 22388 47146 rl w2 x2+a50 ; 22389 47148 22389 47148 bz w0 x2+a13 ; if state(sender.buf) = stopped then 22390 47150 sz w0 a105 ; 22391 47152 jl. j2. ; goto result 2; 22392 47154 22392 47154 dl w0 x3+12 ; w3 := first addr.buf; w0 := last addr.buf; 22393 47156 sl w3 (x2+a17) ; if addresses outside sender-process then 22394 47158 sl w0 (x2+a18) ; 22395 47160 jl. j3. ; goto result 3; 22396 47162 la. w3 h0. ; 22397 47164 la. w0 h0. ; (make addresses even) 22398 47166 sh w0 x3-1 ; if last address < first address then 22399 47168 jl. j3. ; goto result 3; 22400 47170 22400 47170 ws w0 6 ; w0 := size of area(buf); (less two bytes) 22401 47172 c. 8000 ; if rc8000 then 22402 47172 wa w3 x2+a182 ; w3 := abs first of area(buf); 22403 47174 z. 22404 47174 ds. w0 h3. ; save (first addr, size); 22405 47176 22405 47176 dl. w0 h1. ; 22406 47178 la w3 x1+a29 ; w3 := first of area.sender; (even) 22407 47180 la w0 x1+a31 ; w0 := last of area.sender; (even) 22408 47182 ws w0 6 ; w0 := size of area.sender; (less two bytes) 22409 47184 c. 8000 ; if rc8000 then 22410 47184 wa w3 x1+a182 ; w3 := abs first of area.sender; 22411 47186 z. 22412 47186 22412 47186 al w2 x3 ; w2 := from := abs first of area.sender; 22413 47188 rl w3 x1+a30 ; 22414 47190 bz w3 x3+8 ; w3 := operation.buf.sender; 22415 47192 rl. w1 h2. ; w1 := to := abs first of area(buf); 22416 47194 22416 47194 sn w3 3 ; if operation.buf = input then 22417 47196 jl. g5. ; goto prepare move; 22418 47198 se w3 5 ; if operation.buf <> output then 22419 47200 jl. j3. ; goto result 3; 22420 47202 h4: rx w2 2 ;used; exchange (from, to); 22421 47204 22421 47204 g5: ; prepare move: 22422 47204 22422 47204 ; w0 = size of area.sender (less two) 22423 47204 ; w1 = to-address 22424 47204 ; w2 = from-address 22425 47204 22425 47204 sl. w0 (h3.) ; bytes to move := 22426 47206 rl. w0 h3. ; minimum (size.sender, size.buf) 22427 47208 ba. w0 h4.+1 ; + 2; 22428 47210 rs. w0 h3. ; save (bytes to move); 22429 47212 22429 47212 jl. w3 e31. ; move; 22430 47214 22430 47214 ; now the data has been moved between sender-process and buffer-area 22431 47214 ; compute the number of bytes and characters transferred and deliver to 22432 47214 ; sender-process 22433 47214 22433 47214 rl. w2 h3. ; w2 := bytes moved; 22434 47216 al w3 x2 ; 22435 47218 ls w3 -1 ; 22436 47220 wa w3 4 ; w3 := chars moved; ( = bytes * 3 / 2 ) 22437 47222 22437 47222 rl. w1 (d20.) ; 22438 47224 rs w2 x1+a29 ; save w1.sender := bytes moved; 22439 47226 rs w3 x1+a31 ; save w3.sender := chars moved; 22440 47228 22440 47228 jl. j0. ; goto result 0; 22441 47230 22441 47230 h0: -1 < 1 ; mask for making even 22442 47232 h1: -1 < 1 ; double-mask for making two words even 22443 47234 h2: 0 ; abs first of area(buf) 22444 47236 h3: 0 ; size of area(buf) 22445 47238 ; (later: bytes to move) 22446 47238 22446 47238 e. ; 22447 47238 22447 47238 22447 47238 ; general copy 22448 47238 ; 22449 47238 ; call: m157 22450 47238 ; error return: result 2, if sender.buf is stopped 22451 47238 ; result 3, if message regretted 22452 47238 ; result 3, if addresses illegal 22453 47238 ; result 3, if operation in buffer is even 22454 47238 22454 47238 b. g10, h10 w. 22455 47238 22455 47238 m157: ; general copy: 22456 47238 rl. w1 (d20.) ; w1:= sender 22457 47240 rl w3 x1+a30 ; w3:= buf:= save w2.sender 22458 47242 rl w2 x3+6 ; w2:= sender.buf 22459 47244 sh w2 -1 ; if sender.buf<0 then 22460 47246 jl. j3. ; goto result3 22461 47248 ; 22462 47248 rl w0 x2+a10 ; if sender.buf is a pseudo process 22463 47250 sn w0 64 ; then sender.buf:= main(sender.buf); 22464 47252 rl w2 x2+a50 ; 22465 47254 bz w0 x2+a13 ; if state(sender.buf)=stopped then 22466 47256 sz w0 a105 ; goto result2 22467 47258 jl. j2. ; 22468 47260 ; 22469 47260 bz w0 x3+8 ; if operation.buf not odd then 22470 47262 so w0 2.1 ; goto result3 22471 47264 jl. j3. ; 22472 47266 22472 47266 ; get start and size of area described in messagebuffer 22473 47266 22473 47266 rl w3 x1+a29 ; param:= save w1.sender 22474 47268 c.8000 ; 22475 47268 wa w3 x1+a182 ; w3:= abs addr of param 22476 47270 z. ; 22477 47270 rs. w3 h3. ; save abs addr 22478 47272 rl w3 x3 ; rel of addr:= param.function(bit(1:5)) 22479 47274 ls w3 -1 ; 22480 47276 am (x1+a30) ; first:= mess buf(rel of addr) 22481 47278 dl w0 x3+10 ; last:= mess buf(rel of addr+2) 22482 47280 sl w3 (x2+a17) ; if first<first addr(sender) or 22483 47282 sl w0 (x2+a18) ; last>=top addr(sender) then 22484 47284 jl. j3. ; goto result3 22485 47286 ; 22486 47286 am. (h3.) ; first:= first+relative.param 22487 47288 wa w3 6 ; first in buf:= even(first) 22488 47290 la. w3 h0. ; 22489 47292 la. w0 h0. ; size in buf:= even(last)-first 22490 47294 ws w0 6 ; 22491 47296 sh w0 -1 ; if size in buf<0 then 22492 47298 jl. j3. ; goto result3 22493 47300 ; note: size in buf is missing two halfwords 22494 47300 c. 8000 ; 22495 47300 wa w3 x2+a182 ; w3:= abs addr of first in buf 22496 47302 z. ; 22497 47302 ds. w0 h2. ; save(first in buf, size in buf) 22498 47304 22498 47304 ; get start and size of corearea 22499 47304 22499 47304 rl. w3 h3. ; first in core:= even(first addr.param) 22500 47306 dl w0 x3+4 ; last:= even(last addr.param) 22501 47308 la. w3 h0. ; size in core:= last - first in core 22502 47310 la. w0 h0. ; 22503 47312 ws w0 6 ; 22504 47314 c. 8000 ; 22505 47314 wa w3 x1+a182 ; w3:= abs addr of first in core 22506 47316 z. ; 22507 47316 22507 47316 ; get minimum size of core- and buffer area 22508 47316 22508 47316 sl. w0 (h2.) ; size to move:= 22509 47318 rl. w0 h2. ; min(size in buf, size in core)+2 22510 47320 ba. w0 h4. ; saved w1.sender:= size to move 22511 47322 rs w0 x1+a29 ; 22512 47324 22512 47324 ; check direction in which to move 22513 47324 22513 47324 al w2 x3 ; from:= first in core 22514 47326 rl. w1 h1. ; to:= first in buf 22515 47328 rl. w3 (h3.) ; if param.function(bit(0))=0 then 22516 47330 so w3 2.1 ; exchange(to,from) 22517 47332 rx w2 2;used ; 22518 47334 h4=k-1 ; 22519 47334 am -2048 ; 22520 47336 jl. w3 e31.+2048 ; move(size to move,to,from) 22521 47338 ; 22522 47338 jl. j0. ; goto result0 22523 47340 22523 47340 h0: -1<1 ; mask to remove bit 0 22524 47342 h1: 0 ; saved first in buf 22525 47344 h2: 0 ; saved size in buf 22526 47346 h3: 0 ; saved parameter address 22527 47348 22527 47348 e. ; end of general copy 22528 47348 22528 47348 22528 47348 22528 47348 22528 47348 ; setup pseudo process 22529 47348 ; 22530 47348 ; the pseudo-process claim is decreased and an empty pseudo-process 22531 47348 ; is initialized according to entry.work 22532 47348 ; 22533 47348 ; call: m158 22534 47348 ; error return: result 1, if pseudo process claims exceeded 22535 47348 22535 47348 m158: ; setup pseudo process: 22536 47348 rl. w1 (d20.) ; 22537 47350 bz w3 x1+a23 ; if pseudo-process claims.sender exceeded then 22538 47352 sn w3 0 ; 22539 47354 jl. j1. ; goto result 1; 22540 47356 22540 47356 al w3 x3-1 ; decrease(pseudo-process claims.sender); 22541 47358 hs w3 x1+a23 ; 22542 47360 am -2048 ; 22543 47362 22543 47362 jl. w3 e44.+2048; find idle pseudo process; 22544 47364 b26 ; 22545 47366 22545 47366 ; w2 = pseudo process 22546 47366 rl w0 x1+a30 ; 22547 47368 rs w0 x2+a60 ; mref.pseudo:= save w2(cur) 22548 47370 22548 47370 rs w1 x2+a50 ; mainproc.pseudo := sender; 22549 47372 al w0 64 ; 22550 47374 rs w0 x2+a10 ; kind.pseudo := pseudo process; 22551 47376 22551 47376 jl. n0. ; next instruction; 22552 47378 22552 47378 22552 47378 22552 47378 ; redefine m-names: 22553 47378 22553 47378 m00 = m00-n50, m01 = m01-n50, m02 = m02-n50, m03 = m03-n50, m04 = m04-n50, 22554 47378 m05 = m05-n50, m06 = m06-n50, , m08 = m08-n50, m09 = m09-n50, 22555 47378 m10 = m10-n50, m11 = m11-n50, , m13 = m13-n50, m14 = m14-n50, 22556 47378 m15 = m15-n50, m16 = m16-n50, m17 = m17-n50, m18 = m18-n50, m19 = m19-n50, 22557 47378 m20 = m20-n50, m21 = m21-n50, m22 = m22-n50, m23 = m23-n50, m24 = m24-n50, 22558 47378 m25 = m25-n50, m26 = m26-n50, m27 = m27-n50, m28 = m28-n50, m29 = m29-n50, 22559 47378 m30 = m30-n50, m31 = m31-n50, m32 = m32-n50, , m34 = m34-n50, 22560 47378 m35 = m35-n50, m36 = m36-n50, m37 = m37-n50, m38 = m38-n50, m39 = m39-n50, 22561 47378 m40 = m40-n50, m41 = m41-n50, m42 = m42-n50, m43 = m43-n50, , 22562 47378 m45 = m45-n50, m46 = m46-n50, m47 = m47-n50, m48 = m48-n50, m49 = m49-n50, 22563 47378 m50 = m50-n50, , , , , 22564 47378 m55 = m55-n50, m56 = m56-n50, m57 = m57-n50, m58 = m58-n50, m59 = m59-n50, 22565 47378 m60 = m60-n50, , m62 = m62-n50, m63 = m63-n50, m64 = m64-n50, 22566 47378 m65 = m65-n50, m66 = m66-n50, m67 = m67-n50, m68 = m68-n50, m69 = m69-n50, 22567 47378 m70 = m70-n50, m71 = m71-n50, m72 = m72-n50, m73 = m73-n50, m74 = m74-n50, 22568 47378 m75 = m75-n50, m76 = m76-n50, m77 = m77-n50, m78 = m78-n50, m79 = m79-n50, 22569 47378 m80 = m80-n50, , , m83 = m83-n50, m84 = m84-n50, 22570 47378 m85 = m85-n50, m86 = m86-n50, m87 = m87-n50, m88 = m88-n50, m89 = m89-n50, 22571 47378 m90 = m90-n50, m91 = m91-n50, , , , 22572 47378 m100=m100-n50, m101=m101-n50, m102=m102-n50, m103=m103-n50, m104=m104-n50, 22573 47378 m105=m105-n50, m106=m106-n50, m107=m107-n50, m108=m108-n50, m109=m109-n50, 22574 47378 m115=m115-n50, m116=m116-n50, m117=m117-n50, m118=m118-n50, m119=m119-n50, 22575 47378 m120=m120-n50, m121=m121-n50, m122=m122-n50, m123=m123-n50, , 22576 47378 m125=m125-n50, m126=m126-n50, m127=m127-n50, m128=m128-n50, , 22577 47378 , , , , m149=m149-n50, 22578 47378 m150=m150-n50, m151=m151-n50, m152=m152-n50, m153=m153-n50, m154=m154-n50, 22579 47378 m155=m155-n50, m156=m156-n50, m157=m157-n50, m158=m158-n50, , 22580 47378 m260=m260-n50 , m280=m280-n50 , 22581 47378 22581 47378 j0=j0-n50, j1=j1-n50, j2=j2-n50, j3=j3-n50, j4=j4-n50, 22582 47378 j5=j5-n50, j6=j6-n50, j7=j7-n50 22583 47378 \f 22583 47378 22583 47378 22583 47378 ; the following few instructions all perform an exit: 22584 47378 h. ; (the whole table is in halfword mode) 22585 47378 r0: j0 ; goto result ok; 22586 47379 r1: j1 ; goto result 1; 22587 47380 r2: j2 ; goto result 2; 22588 47381 r3: j3 ; goto result 3; 22589 47382 r4: j4 ; goto result 4; 22590 47383 r5: j5 ; goto result 5; 22591 47384 r6: j6 ; goto result 6; 22592 47385 r7: j7 ; goto result 7; 22593 47386 22593 47386 22593 47386 22593 47386 ; procedure set aux entry 22594 47386 b. g10 h. 22595 47386 22595 47386 p0: ; 22596 47386 m77 , g3. ; if key.work < min aux key then goto skip-return; 22597 47388 m4 ; set aux cat; 22598 47389 m18 ; test new catalog name: 22599 47390 g5. ; overlap: goto error-return; 22600 47391 g0. ; exact : goto copy; 22601 47392 ; no entry was found: create one now 22602 47392 m55 ; find empty entry: 22603 47393 g5. ; overlap or no room: goto error-return; 22604 47394 m60 ; clear access counters.work; 22605 47395 m125, g1. ; goto modify; 22606 47397 g0: ; copy: 22607 47397 m64 ; move statarea.entry to statarea.work; 22608 47398 g1: ; modify: 22609 47398 m56 ; modify cur entry; 22610 47399 m88, g2. ; if size.work>=0 then 22611 47401 m62 ; update and insert statarea; 22612 47402 g2: ; 22613 47402 m5 ; set main cat; 22614 47403 g3: ; skip-return: 22615 47403 m127 ; skip-return; 22616 47404 22616 47404 g5: ; error-return: 22617 47404 m5 ; set main cat; 22618 47405 m128 ; error-return; 22619 47406 e. ; 22620 47406 22620 47406 22620 47406 22620 47406 ; procedure delete aux entry 22621 47406 b. g10 h. 22622 47406 p1: ; 22623 47406 m4 ; set aux cat; 22624 47407 m18 ; test new catalog name: 22625 47408 g5. ; overlap: goto set maincat; 22626 47409 g0. ; exact : goto delete; 22627 47410 ; no entry was found, i.e. don't delete anything 22628 47410 m125, g5. ; goto return; 22629 47412 22629 47412 g0: ; delete: 22630 47412 m57 ; delete cur entry; 22631 47413 g5: ; return: 22632 47413 m5 ; set main cat; 22633 47414 m126 ; return; 22634 47415 e. ; 22635 47416 22635 47416 22635 47416 22635 47416 ; create entry 22636 47416 ; 22637 47416 ; call: 22638 47416 ; w1.sender : tail address 22639 47416 ; w3.sender : name address 22640 47416 ; return: 22641 47416 ; w0.sender : result = 0 : entry created 22642 47416 ; result = 2 : catalog io-error 22643 47416 ; result = 2 : document not present 22644 47416 ; result = 2 : document not ready 22645 47416 ; result = 3 : name overlap or name already exists 22646 47416 ; result = 4 : claims exceeded 22647 47416 ; result = 5 : catbase.sender outside stdbase.sender 22648 47416 ; result = 6 : nameformat (of entry-name) illegal 22649 47416 ; result = 6 : nameformat (of document name) illegal 22650 47416 ; result = 7 : maincat not present 22651 47416 22651 47416 p20: ; create entry: 22652 47416 m0 , r7. ; if no maincat then result 7; 22653 47418 m65 ; move catbase,name to work; 22654 47419 m90 ; clear first slice.work; 22655 47420 m80 ; clear key.work; 22656 47421 m75 ; test base,key.work: 22657 47422 r5. ; illegal: result 5; 22658 47423 m15 ; test new system name (maybe wrk-name); 22659 47424 r3. ; overlap: result 3; 22660 47425 r3. ; exact : result 3; 22661 47426 m105 ; move tail to work; 22662 47427 m35 , t3 ; search any chains (state = ready); 22663 47429 m22 , 2.10 ; compute slices to claim (compute new slices); 22664 47431 m30 ; test claims (create): 22665 47432 r4. ; claims exceeded: result 4; 22666 47433 m23 ; adjust chain to size; 22667 47434 m55 ; find empty entry: 22668 47435 r4. ; no room: result 4; (not possible) 22669 47436 m56 ; modify cur entry; 22670 47437 m101 ; move name.work to name.sender; (in case of wrk-name) 22671 47438 j0 ; result ok; 22672 47439 22672 47439 22672 47439 22672 47439 ; lookup entry 22673 47439 ; 22674 47439 ; call: 22675 47439 ; w1.sender : tail address 22676 47439 ; w3.sender : name address 22677 47439 ; 22678 47439 ; return: 22679 47439 ; w0.sender : result = 0 : entry looked up 22680 47439 ; result = 2 : catalog io-error 22681 47439 ; result = 3 : entry does not exist 22682 47439 ; result = 6 : nameformat illegal 22683 47439 ; result = 7 : maincat not present 22684 47439 22684 47439 p21: ; lookup entry: 22685 47439 m0 , r7. ; if no maincat then result 7; 22686 47441 m65 ; move catbase,name to work; 22687 47442 m10 ; search best catalog entry: 22688 47443 r3. ; not found: result 3; 22689 47444 m106 ; move tail.work to tail.sender; 22690 47445 j0 ; result ok; 22691 47446 22691 47446 22691 47446 22691 47446 ; lookup entry head and tail: 22692 47446 ; 22693 47446 ; call: 22694 47446 ; w1.sender : entry address 22695 47446 ; w3.sender : name address 22696 47446 ; 22697 47446 ; return: 22698 47446 ; w0.sender : result (as lookup entry) 22699 47446 22699 47446 p38: ; lookup entry head and tail: 22700 47446 m0 , r7. ; if no maincat then result 7; 22701 47448 m65 ; move catbase,name to work; 22702 47449 m10 ; search best catalog entry: 22703 47450 r3. ; not found: result 3; 22704 47451 m108 ; move entry.work to entry.sender; 22705 47452 j0 ; result ok; 22706 47453 22706 47453 22706 47453 22706 47453 ; change entry 22707 47453 ; 22708 47453 ; call: 22709 47453 ; w1.sender : tail address 22710 47453 ; w3.sender : name address 22711 47453 ; 22712 47453 ; return: 22713 47453 ; w0.sender : result = 0 : entry changed 22714 47453 ; result = 2 : catalog io-error 22715 47453 ; result = 2 : document not ready 22716 47453 ; result = 3 : entry does not exist 22717 47453 ; result = 4 : entry protected against calling process 22718 47453 ; (i.e. base.entry outside maxbase.sender) 22719 47453 ; result = 5 : entry reserved by another process 22720 47453 ; result = 6 : nameformat illegal 22721 47453 ; result = 6 : new size illegal 22722 47453 ; result = 6 : claims exceeded 22723 47453 ; result = 7 : maincat not present 22724 47453 22724 47453 b. g10 h. 22725 47453 22725 47453 p22: ; change entry: 22726 47453 m0 , r7. ; if no maincat then result 7; 22727 47455 m65 ; move catbase,name to work; 22728 47456 m11 , a52 ; search best entry and test modif allowed (no reserver); 22729 47458 m36 , t3 ; search chain (state = ready); 22730 47460 m89 ; move tail to work and test new size; 22731 47461 m22 , 2.11 ; compute slices to claim (compute new slices and count old slices); 22732 47463 m29 ; test claims (change): 22733 47464 r6. ; exceeded: result 6; 22734 47465 m23 ; adjust chain; 22735 47466 m88 ; if size.work >= 0 then 22736 47467 g0. ; begin 22737 47468 m66 ; move docname.curdoc to docname.entry; 22738 47469 m77 , g0. ; if key.work >= min aux key 22739 47471 m24 ; and area extended then 22740 47472 m6 ; dump chaintable; 22741 47473 g0: ; end; 22742 47473 m48 ; if area process then reinit area process; 22743 47474 m56 ; modify cur entry; 22744 47475 m58 ; set aux entry: 22745 47476 g1. ; overlap or no room: does'nt matter 22746 47477 g1: ; 22747 47477 j0 ; result ok; 22748 47478 22748 47478 e. ; 22749 47478 22749 47478 22749 47478 22749 47478 ; rename entry 22750 47478 ; 22751 47478 ; call: 22752 47478 ; w1.sender : new name address 22753 47478 ; w3.sender : name address 22754 47478 ; 22755 47478 ; return: 22756 47478 ; w0.sender : result = 0 : entry renamed 22757 47478 ; result = 2 : catalog io-error 22758 47478 ; result = 2 : document not ready 22759 47478 ; result = 3 : entry not found 22760 47478 ; result = 3 : name overlap (new name) 22761 47478 ; result = 3 : new name exists 22762 47478 ; result = 4 : entry protected against calling process 22763 47478 ; (i.e. base.entry outside maxbase.sender) 22764 47478 ; result = 5 : entry used by another process 22765 47478 ; result = 6 : old or new name format illegal 22766 47478 ; result = 7 : maincat not present 22767 47478 22767 47478 b. g10 h. 22768 47478 22768 47478 p23: ; rename entry: 22769 47478 m0 , r7. ; if no maincat then result 7; 22770 47480 m103 ; move newname.sender to name.work; 22771 47481 m13 ; test name format (newname); 22772 47482 m65 ; move catbase,name to work; 22773 47483 m11 , a53 ; search best entry and test modif allowed (no users); 22774 47485 m36 , t3 ; search chain (state = ready); 22775 47487 m57 ; delete cur entry; 22776 47488 m103 ; move newname.sender to name.work; 22777 47489 m17 ; test new system name (no wrk-name): 22778 47490 g10. ; overlap: goto repair maincat; 22779 47491 g10. ; already: goto repair maincat; 22780 47492 m55 ; find empty entry: 22781 47493 r7. ; no room: (result 7: not possible) 22782 47494 m56 ; modify cur entry; 22783 47495 m77 ; if key.work >= min aux key then 22784 47496 g2. ; begin 22785 47497 m100 ; name.work := name.sender; 22786 47498 m59 ; delete aux entry (old name); 22787 47499 m103 ; restore new name; 22788 47500 g2: ; end; 22789 47500 m58 ; set aux entry (new name); 22790 47501 g5. ; overlap or no room: goto repair auxcat; 22791 47502 m48 ; if area process then reinit area process; 22792 47503 j0 ; result ok; 22793 47504 22793 47504 g5: ; repair auxcat: 22794 47504 m100 ; restore old name; 22795 47505 m58 ; set aux entry: 22796 47506 g6. ; overlap or no room: does'nt matter 22797 47507 g6: ; 22798 47507 m103 ; restore new name; 22799 47508 m18 ; test new catalog name (new name): 22800 47509 r7. ; overlap: result 7; (not possible) 22801 47510 g7. ; exact : goto remove new name; 22802 47511 j7 ; not found: result 7; (not possible) 22803 47512 g7: ; remove new name: 22804 47512 m57 ; delete cur entry; 22805 47513 22805 47513 g10: ; repair maincat: 22806 47513 m100 ; restore old name; 22807 47514 m14 ; compute name key; 22808 47515 m55 ; find empty entry: 22809 47516 r7. ; no room: result 7; (not possible) 22810 47517 m56 ; modify cur entry; 22811 47518 j3 ; result 3; 22812 47519 22812 47519 e. ; 22813 47520 22813 47520 22813 47520 22813 47520 ; remove entry 22814 47520 ; 22815 47520 ; call: 22816 47520 ; w3.sender : name address 22817 47520 ; 22818 47520 ; return: 22819 47520 ; w0.sender : result = 0 : entry removed 22820 47520 ; result = 2 : catalog io-error 22821 47520 ; result = 2 : document not ready 22822 47520 ; result = 3 : entry not found 22823 47520 ; result = 4 : entry protected against calling process 22824 47520 ; (i.e. base.entry outside maxbase.sender) 22825 47520 ; result = 5 : entry used by another process 22826 47520 ; result = 6 : nameformat illegal 22827 47520 ; result = 7 : maincat not present 22828 47520 22828 47520 b. g10 h. 22829 47520 22829 47520 p24: ; remove entry: 22830 47520 m0 , r7. ; if no maincat then result 7; 22831 47522 m65 ; move catbase,name to work; 22832 47523 m11 , a53 ; search best entry and test modif allowed (no users); 22833 47525 m36 , t3 ; search chain (state = ready); 22834 47527 m22 , 2.01 ; compute slices to claim (count old slices); 22835 47529 m28 ; test claims (remove); 22836 47530 r7. ; claims exceeded: result 7; (not possible) 22837 47531 m23 ; adjust chain to size; 22838 47532 m50 ; if areaprocess then delete areaprocess; 22839 47533 m57 ; delete cur entry; 22840 47534 m77 , g5. ; if key.work >= min aux key then 22841 47536 m59 ; delete aux entry; 22842 47537 g5: ; 22843 47537 j0 ; result ok; 22844 47538 22844 47538 e. ; 22845 47538 22845 47538 22845 47538 22845 47538 ; permanent entry 22846 47538 ; 22847 47538 ; call: 22848 47538 ; w1.sender : permanens key 22849 47538 ; w3.sender : name address 22850 47538 ; 22851 47538 ; return: 22852 47538 ; w0.sender : result = 0 : entry-permanens changed 22853 47538 ; result = 2 : catalog io-error 22854 47538 ; result = 2 : document not ready 22855 47538 ; result = 3 : entry does not exist 22856 47538 ; result = 3 : overlap (or no room) in auxcat 22857 47538 ; result = 4 : entry protected against calling process 22858 47538 ; (i.e. base.entry outside maxbase.sender) 22859 47538 ; result = 4 : key illegal 22860 47538 ; result = 5 : entry reserved by another process 22861 47538 ; result = 6 : nameformat illegal 22862 47538 ; result = 6 : claims exceeded 22863 47538 ; result = 7 : maincat not present 22864 47538 22864 47538 b. g20 h. 22865 47538 22865 47538 p25: ; permanent entry: 22866 47538 m0 , r7. ; if maincat not present then result 7; 22867 47540 g0: ; 22868 47540 m65 ; move catbase,name to work; 22869 47541 m11 , a52 ; search best entry and test modif allowed (no reserver); 22870 47543 g1: ; entry found: 22871 47543 m36 , t3 ; search chain (state = ready) 22872 47545 g2: ; chain found: 22873 47545 m78 ; save oldkey, key.work := param, test key legal; 22874 47546 m75 ; test base,key: 22875 47547 r4. ; key < minaux and base outside stdbase: result 4; 22876 47548 m22 , 2.01 ; compute slices to claim (count old slices); 22877 47550 m27 ; test claims (permanent): 22878 47551 r6. ; exceeded: result 6; 22879 47552 m88 , g8. ; if size < 0 then goto file-descriptor; 22880 47554 g4: ; modify maincat: 22881 47554 m56 ; modify cur entry; 22882 47555 m77 ; if key.work >= min aux key then 22883 47556 g5. ; begin 22884 47557 m6 ; dump chaintable; 22885 47558 m58 ; set aux entry: 22886 47559 g10. ; overlap or no room: goto repair maincat; 22887 47560 j0 ; result ok; 22888 47561 g5: ; end; 22889 47561 m79 ; restore old key; 22890 47562 m77 , g6. ; if key.work >= min aux key then 22891 47564 m59 ; delete aux entry; 22892 47565 g6: ; 22893 47565 j0 ; result ok; 22894 47566 22894 47566 g8: ; file-descriptor: 22895 47566 m77 , g9. ; if key.work >= min aux key then 22896 47568 m91 ; slice.work := docnumber; (result 5 not possible) 22897 47569 m125, g4. ; 22898 47571 g9: ; else 22899 47571 m90 ; first slice.work := 0; 22900 47572 m125, g4. ; goto modify maincat; 22901 47574 22901 47574 g10: ; repair maincat: 22902 47574 m79 ; restore old key; 22903 47575 m18 ; test new catalog name: 22904 47576 r7. ; overlap: result 7; (not possible) 22905 47577 g11. ; exact : goto modify maincat entry; 22906 47578 j7 ; not found: result 7; (not possible) 22907 47579 g11: ; modify maincat entry: 22908 47579 m56 ; modify cur entry; 22909 47580 j3 ; result 3; 22910 47581 22910 47581 22910 47581 22910 47581 22910 47581 ; permanent entry in auxcat 22911 47581 ; 22912 47581 ; call: 22913 47581 ; w1.sender : permanens key 22914 47581 ; w2.sender : docname address 22915 47581 ; w3.sender : name address 22916 47581 ; 22917 47581 ; return: 22918 47581 ; w0.sender : result (as permanent entry) 22919 47581 ; result = 2 : document not found 22920 47581 ; result = 5 : entry already permanent in another auxcat 22921 47581 ; result = 6 : docname format illegal 22922 47581 22922 47581 p45: ; permanent entry in auxcat: 22923 47581 m0 , r7. ; if no maincat then result 7; 22924 47583 m65 ; move catbase,name to work; 22925 47584 m78 ; (save oldkey), key.work := param, test key; 22926 47585 m77 ; if key.work < min aux key then 22927 47586 g0. ; goto permanent entry; 22928 47587 m104 ; move docname.sender to docname.work; 22929 47588 m84 ; (size.work := 0) 22930 47589 m36 , t3 ; search chain (state = ready) 22931 47591 m11 , a52 ; search best entry and test modif allowed (no reserver); 22932 47593 m88 , g20. ; if size.work >= 0 then 22933 47595 m125, g1. ; goto entry found; (new docname irrellevant) 22934 47597 g20: ; file-descriptor: 22935 47597 m91 ; slice.work := docnumber; (maybe result 5) 22936 47598 m125, g2. ; goto chain found; 22937 47600 22937 47600 e. ; 22938 47600 22938 47600 22938 47600 22938 47600 ; create area process 22939 47600 ; 22940 47600 ; call: 22941 47600 ; w3.sender : name address 22942 47600 ; 22943 47600 ; return: 22944 47600 ; w0.sender : result = 0 : area process created 22945 47600 ; result = 1 : area claims exceeded 22946 47600 ; result = 2 : catalog io-error 22947 47600 ; result = 2 : state of document does not permit this call 22948 47600 ; result = 3 : entry not found 22949 47600 ; result = 4 : entry does not describe an area 22950 47600 ; (i.e. size.entry < 0) 22951 47600 ; result = 6 : nameformat illegal 22952 47600 22952 47600 b. g10 h. 22953 47600 22953 47600 p26: ; create area process: 22954 47600 m0 , g5. ; if no maincat then goto test areaprocs; 22955 47602 m65 ; move catbase,name to work; 22956 47603 m10 ; search best catalog entry: 22957 47604 g5. ; not found: goto test areaprocs; 22958 47605 m88 , r4. ; if size.work < 0 then result 4; 22959 47607 ; notice: if the document is being dismounted etc. it is not allowed 22960 47607 ; to create area processes: 22961 47607 m36 , t30 ; search chains (state = allowed for create area process); 22962 47609 m46 , 2 ; setup area process (sender); 22963 47611 j0 ; result ok; 22964 47612 22964 47612 g5: ; test areaprocs: 22965 47612 ; remember: none of the catalogs are described in maincatalog yet, 22966 47612 ; therefor special care must be taken, when a process wants to 22967 47612 ; have an areaprocess to one of the catalogs: 22968 47612 m45 ; search best area process: 22969 47613 r3. ; not found: result 3; 22970 47614 m47 , 2 ; include in areaprocess (sender); 22971 47616 j0 ; result ok; 22972 47617 22972 47617 e. ; 22973 47618 22973 47618 22973 47618 22973 47618 ; create entry lock process 22974 47618 ; 22975 47618 ; call: 22976 47618 ; w3.sender : name address ( with room for name table address ) 22977 47618 ; 22978 47618 ; return: 22979 47618 ; w0.sender : result = 0 : process created 22980 47618 ; result = 1 : area claims exceeded 22981 47618 ; result = 2 : catalog io-error 22982 47618 ; result = 2 : state of document does not permit this call 22983 47618 ; result = 3 : entry not found 22984 47618 ; result = 6 : nameformat illegal 22985 47618 ; result = 7 : maincat not present 22986 47618 22986 47618 p46: ; create entry lock process: 22987 47618 m0 , r7. ; if no maincat then result 7; 22988 47620 m65 ; move catbase,name to work; 22989 47621 m10 ; search best catalog entry: 22990 47622 r3. ; not found: result 3; 22991 47623 ; (see comment at create area process) 22992 47623 m36 , t30 ; search chain (state = allowed for create area process); 22993 47625 m46 , 2 ; setup area process (sender); 22994 47627 m83 ; prepare for moving nametable address to sender; 22995 47628 m102 ; move (name and) nametable address to sender; 22996 47629 j0 ; result ok; 22997 47630 22997 47630 22997 47630 22997 47630 ; create peripheral process 22998 47630 ; 22999 47630 ; call: 23000 47630 ; w1.sender : device number 23001 47630 ; w3.sender : name address 23002 47630 ; 23003 47630 ; return: 23004 47630 ; w0.sender : result = 0 : peripheral process created 23005 47630 ; result = 1 : function forbidden in calling process 23006 47630 ; result = 2 : calling process is not a user 23007 47630 ; result = 2 : catalog io-error 23008 47630 ; result = 3 : name overlap 23009 47630 ; result = 3 : name already exists 23010 47630 ; result = 3 : not same disc name 23011 47630 ; result = 4 : device number does not exist 23012 47630 ; result = 5 : device is reserved by another user 23013 47630 ; result = 6 : nameformat illegal 23014 47630 23014 47630 b. g10 h. 23015 47630 23015 47630 p27: ; create peripheral process: 23016 47630 m8 , f74 ; check function mask (create peripheral process); 23017 47632 m149 ; test device, user, reserver; 23018 47633 m65 ; move catbase,name to work; 23019 47634 m34 ; if not bs-device then 23020 47635 g5. ; goto not bs; 23021 47636 23021 47636 ; all bs-devices will have catalog-interval, with no regard on a future 23022 47636 ; catalog-system or not. 23023 47636 ; this ensures that all bs-devices have distinct names, and that 23024 47636 ; that bs-documents (i.e. bs-devices included in catalog-system) may 23025 47636 ; loose its connection to the device (e.g. the device-name is cleared 23026 47636 ; at intervention at the disc), and later resume the connection, 23027 47636 ; without any risk that the device-name has been occupied by another 23028 47636 ; device. 23029 47636 23029 47636 m70 ; base.work := catalog interval; 23030 47637 m43 ; compare name.work and docname.chain.proc: 23031 47638 ; (if connection between proc and a chain then 23032 47638 ; the names must agree) 23033 47638 g5. ; no chain: goto not bs; 23034 47639 m66 ; docname.work := docname.chain; 23035 47640 m40 ; reinit rest of chainhead; 23036 47641 ; (i.e. insert procfunc as user and reserver of disc) 23037 47641 m125 , g10. ; goto set name and interval; 23038 47643 23038 47643 g5: ; not bs: 23039 47643 m15 ; test new system name (maybe wrk-name): 23040 47644 r3. ; overlap: result 3; 23041 47645 r3. ; exact : result 3; 23042 47646 m101 ; move name.work to name.sender; (in case of wrk-name) 23043 47647 23043 47647 g10: ; set name and interval: 23044 47647 m150 ; set name and interval; 23045 47648 j0 ; result ok; 23046 47649 e. ; 23047 47650 23047 47650 23047 47650 23047 47650 ; create internal process 23048 47650 ; 23049 47650 ; call: 23050 47650 ; w1.sender : parameter address 23051 47650 ; w3.sender : name address 23052 47650 ; 23053 47650 ; return: 23054 47650 ; w0.sender : result = 0 : internal process created 23055 47650 ; result = 1 : storage area outside calling process 23056 47650 ; result = 1 : internal claims exceeded 23057 47650 ; result = 1 : illegal protection 23058 47650 ; result = 1 : maxbase or stdbase not contained in 23059 47650 ; corresponding base of calling process 23060 47650 ; result = 2 : catalog io-error 23061 47650 ; result = 3 : name overlap 23062 47650 ; result = 3 : name already exists 23063 47650 ; result = 6 : nameformat illegal 23064 47650 23064 47650 p28: ; create internal process: 23065 47650 m65 ; move catbase,name to work; 23066 47651 m15 ; test new system name (maybe wrk-name): 23067 47652 r3. ; overlap: result 3; 23068 47653 r3. ; exact : result 3; 23069 47654 m101 ; move name.work to name.sender (in case of wrk-name); 23070 47655 m151 ; create internal process; 23071 47656 m150 ; set name and interval; 23072 47657 j0 ; result ok; 23073 47658 23073 47658 23073 47658 23073 47658 ; start internal process 23074 47658 ; 23075 47658 ; call: 23076 47658 ; w3.sender : name address 23077 47658 ; 23078 47658 ; return: 23079 47658 ; w0.sender : result = 0 : internal process started 23080 47658 ; ( result = 2 : state of process does not permit start ) 23081 47658 ; result = 3 : process does not exist 23082 47658 ; result = 3 : process is not an internal process 23083 47658 ; result = 3 : process is not a child of calling process 23084 47658 ; result = 6 : nameformat illegal 23085 47658 23085 47658 p29: ; start internal process: 23086 47658 m65 ; move catbase,name to work; 23087 47659 m152 ; start internal process; 23088 47660 23088 47660 23088 47660 23088 47660 ; stop internal process 23089 47660 ; 23090 47660 ; call: 23091 47660 ; w3.sender : name address 23092 47660 ; 23093 47660 ; return: 23094 47660 ; w0.sender : result = 0 : stop initiated 23095 47660 ; result = 3 : process does not exist 23096 47660 ; result = 3 : process is not an internal process 23097 47660 ; result = 3 : process is not a child of calling process 23098 47660 ; result = 6 : nameformat illegal 23099 47660 ; w2.sender : buffer address (in case result=0) 23100 47660 23100 47660 p30: ; stop internal process: 23101 47660 m65 ; move catbase,name to work; 23102 47661 m153 ; stop internal process; 23103 47662 23103 47662 23103 47662 23103 47662 ; modify internal process 23104 47662 ; 23105 47662 ; call: 23106 47662 ; w1.sender : register address 23107 47662 ; w3.sender : name address 23108 47662 ; 23109 47662 ; return: 23110 47662 ; w0.sender : result = 0 : internal process modified 23111 47662 ; ( result = 2 : state of process does not permit modification ) 23112 47662 ; result = 2 : child ic outside child process 23113 47662 ; result = 3 : process does not exist 23114 47662 ; result = 3 : process in not an internal process 23115 47662 ; result = 3 : process is not a child of calling process 23116 47662 ; result = 6 : nameformat illegal 23117 47662 23117 47662 p31: ; modify internal process: 23118 47662 m65 ; move catbase,name to work; 23119 47663 m154 ; modify internal process; 23120 47664 23120 47664 23120 47664 23120 47664 ; remove process 23121 47664 ; 23122 47664 ; call: 23123 47664 ; w3.sender : name address 23124 47664 ; 23125 47664 ; return: 23126 47664 ; w0.sender : result = 0 : process removed 23127 47664 ; result = 1 : function forbidden in calling process 23128 47664 ; result = 2 : state of process does not permit removal 23129 47664 ; result = 2 : calling process is not a user of process 23130 47664 ; result = 2 : claimed message to pseudo process 23131 47664 ; result = 3 : process does not exist 23132 47664 ; result = 3 : process is not a child of calling process 23133 47664 ; result = 5 : peripheral process reserved by another user 23134 47664 ; result = 6 : nameformat illegal 23135 47664 23135 47664 p32: ; remove process: 23136 47664 m65 ; move catbase,name to work; 23137 47665 m155 ; remove process; 23138 47666 23138 47666 23138 47666 23138 47666 ; generate name 23139 47666 ; 23140 47666 ; call: 23141 47666 ; w3.sender : name address 23142 47666 ; 23143 47666 ; return: 23144 47666 ; w0.sender : result = 0 : wrk-name generated 23145 47666 ; result = 2 : catalog io-error 23146 47666 23146 47666 p34: ; generate name: 23147 47666 m16 ; generate wrk-name: 23148 47667 r7. ; (irrell) 23149 47668 r7. ; (irrell) 23150 47669 m101 ; move name.work to name.sender; 23151 47670 j0 ; result ok; 23152 47671 23152 47671 23152 47671 23152 47671 ; copy 23153 47671 ; 23154 47671 ; call: 23155 47671 ; w1.sender : first address 23156 47671 ; w2.sender : buffer address 23157 47671 ; w3.sender : last address 23158 47671 ; 23159 47671 ; return: 23160 47671 ; w0.sender : result = 0 : area copied 23161 47671 ; result = 2 : sender of buffer is stopped 23162 47671 ; result = 3 : buffer describes input or output 23163 47671 ; outside senders area 23164 47671 ; result = 3 : message regretted 23165 47671 ; result = 3 : operation in buffer is neither input not output 23166 47671 ; w1.sender : bytes moved (if result=0) 23167 47671 ; w3.sender : characters moved (if result=0) 23168 47671 23168 47671 p35: ; copy: 23169 47671 m156 ; copy message; 23170 47672 23170 47672 23170 47672 23170 47672 ; set catalog base 23171 47672 ; 23172 47672 ; call: 23173 47672 ; w0.sender : lower base 23174 47672 ; w1.sender : upper base 23175 47672 ; w3.sender : name address 23176 47672 ; 23177 47672 ; return: 23178 47672 ; w0.sender : result = 0 : catalog base set 23179 47672 ; ( result = 2 : state of process does not permit modification ) 23180 47672 ; result = 3 : process does not exist 23181 47672 ; result = 3 : process is not an internal process 23182 47672 ; result = 3 : process is not a child of calling process 23183 47672 ; result = 4 : newbase illegal 23184 47672 ; result = 6 : nameformat illegal 23185 47672 23185 47672 p36: ; set catalog base: 23186 47672 m65 ; move catbase,name to work; 23187 47673 m69 ; test new catbase.internal 23188 47674 m74 ; set catbase of internal; 23189 47675 j0 ; result ok; 23190 47676 23190 47676 23190 47676 23190 47676 ; set entry base 23191 47676 ; 23192 47676 ; call: 23193 47676 ; w0.sender : lower base 23194 47676 ; w1.sender : upper base 23195 47676 ; w3.sender : name address 23196 47676 ; 23197 47676 ; return: 23198 47676 ; w0.sender : result = 0 : entry interval set 23199 47676 ; result = 2 : catalog io-error 23200 47676 ; result = 2 : document not ready 23201 47676 ; result = 3 : entry not found 23202 47676 ; result = 3 : name overlap (at new base) 23203 47676 ; result = 3 : name already exists (at new base) 23204 47676 ; result = 4 : entry protected against calling process 23205 47676 ; (i.e. oldbase.entry outside maxbase.sender) 23206 47676 ; result = 4 : key,newbase combination illegal 23207 47676 ; result = 5 : entry used by another process 23208 47676 ; result = 6 : nameformat illegal 23209 47676 ; result = 7 : maincat not present 23210 47676 23210 47676 b. g10 h. 23211 47676 23211 47676 p37: ; set entry base: 23212 47676 m0 , r7. ; if no maincat then result 7; 23213 47678 m65 ; move catbase,name to work; 23214 47679 m11 , a53 ; search best entry and test modif allowed (no users) 23215 47681 m36 , t3 ; search chain (state = ready); 23216 47683 m71 ; test new base; 23217 47684 m72 ; save oldbase, base.work := newbase; 23218 47685 r0. ; same base: result ok; 23219 47686 m75 ; test base.work,key.work combination; 23220 47687 r4. ; error: result 4; 23221 47688 m17 ; test new system name (wrk-name not allowed): 23222 47689 r3. ; overlap: result 3; 23223 47690 r3. ; exact : result 3; 23224 47691 m56 ; modify cur entry; 23225 47692 m48 ; if areaprocess then reinit area process; 23226 47693 m77 , r0. ; if key.work < min aux key then result ok; 23227 47695 23227 47695 m4 ; set aux cat; 23228 47696 m18 ; test new catalog name: 23229 47697 g6. ; overlap: goto repair maincat; 23230 47698 g8. ; exact : goto remove superfluous entry; 23231 47699 g0: ; find old entry in auxcat: 23232 47699 m73 ; restore oldbase; 23233 47700 m18 ; test new catalog name: 23234 47701 g1. ; overlap: goto create new; (does'nt matter) 23235 47702 g2. ; exact : goto copy; 23236 47703 ; the entry did not exist in the auxcat 23237 47703 g1: ; create new: 23238 47703 m55 ; find empty entry; 23239 47704 g5. ; no room: goto repair maincat; 23240 47705 m60 ; clear access counters.work; 23241 47706 m125, g3. ; goto modify; 23242 47708 g2: ; copy: 23243 47708 m64 ; move statarea.entry to statarea.work; 23244 47709 g3: ; modify: 23245 47709 m71 ; (test and) get new base; 23246 47710 m72 ; save oldbase, set newbase; 23247 47711 r7. ; (same base: not possible) 23248 47712 m56 ; modify cur entry; 23249 47713 m88, g4. ; if size.work>=0 then 23250 47715 m62 ; update and insert statarea; 23251 47716 g4: ; 23252 47716 m5 ; set maincat; 23253 47717 j0 ; result ok; 23254 47718 23254 47718 g5: ; repair maincat: 23255 47718 m71 ; (test and) get new base; 23256 47719 m72 ; save oldbase, set newbase; 23257 47720 r7. ; (same base: not possible) 23258 47721 g6: ; (newbase set): 23259 47721 m5 ; set maincat; 23260 47722 m18 ; test new catalog name: 23261 47723 r7. ; overlap: result 7; (not possible) 23262 47724 g7. ; exact : goto change main entry; 23263 47725 j7 ; result 7; (not possible) 23264 47726 23264 47726 g7: ; change main entry: 23265 47726 m73 ; restore oldbase; 23266 47727 m56 ; modify cur entry; 23267 47728 j3 ; result 3; 23268 47729 23268 47729 g8: ; remove superfluous entry: 23269 47729 m57 ; delete cur entry; 23270 47730 m125, g0. ; goto find old entry in auxcat; 23271 47732 23271 47732 e. ; 23272 47732 23272 47732 23272 47732 23272 47732 ; set backing storage claims 23273 47732 ; 23274 47732 ; call: 23275 47732 ; w1.sender : claim list address 23276 47732 ; w2.sender : docname address 23277 47732 ; w3.sender : name address 23278 47732 ; 23279 47732 ; result: 23280 47732 ; w0.sender : result = 0 : backing starage claims set 23281 47732 ; result = 1 : claims exceeded (at calling process) 23282 47732 ; result = 1 : claims exceeded (at child) 23283 47732 ; result = 2 : document not found 23284 47732 ; result = 3 : process does not exist 23285 47732 ; result = 3 : process is not an internal process 23286 47732 ; result = 3 : process is not a child of calling process 23287 47732 ; result = 6 : nameformat (of docname) illegal 23288 47732 ; result = 6 : nameformat (of childname) illegal 23289 47732 23289 47732 p39: ; set bs claims: 23290 47732 m104 ; move docname.sender to docname.work; 23291 47733 m84 ; (size.work := 0); 23292 47734 m36 , t29 ; search chain (state = allowed for set bs claims); 23293 47736 m65 ; move catbase,name to work; 23294 47737 m32 ; set bs claims; 23295 47738 23295 47738 23295 47738 23295 47738 ; create pseudo process 23296 47738 ; 23297 47738 ; call: 23298 47738 ; w3.sender : name address 23299 47738 ; 23300 47738 ; return: 23301 47738 ; w0.sender : result = 0 : pseudo process created 23302 47738 ; result = 1 : (area) claims exceeded 23303 47738 ; result = 2 : catalog io-error 23304 47738 ; result = 3 : name overlap 23305 47738 ; result = 3 : name already exists 23306 47738 ; result = 6 : nameformat illegal 23307 47738 23307 47738 p40: ; create pseudo process: 23308 47738 m65 ; move catbase,name to work; 23309 47739 m15 ; test new system name (maybe wrk-name): 23310 47740 r3. ; overlap: result 3; 23311 47741 r3. ; exact : result 3; 23312 47742 m101 ; move name.work to name.sender (in case of wrk-name); 23313 47743 m158 ; create pseudo process; 23314 47744 m150 ; set name and interval; 23315 47745 j0 ; result ok; 23316 47746 23316 47746 ; general copy 23317 47746 ; 23318 47746 ; call: 23319 47746 ; w1.sender: parameter address 23320 47746 ; w2.sender: buffer address 23321 47746 ; 23322 47746 ; return: 23323 47746 ; w0.sender: result = 0 : area copied 23324 47746 ; result - 2 : sender of buffer stopped 23325 47746 ; result = 3 : message regretted 23326 47746 ; result = 3 : illegal addresses in buffer 23327 47746 ; result = 3 : operation in buffer not odd 23328 47746 23328 47746 p42: ; general copy: 23329 47746 m157 ; 23330 47747 23330 47747 23330 47747 23330 47747 ; prepare backing storage 23331 47747 ; 23332 47747 ; call: 23333 47747 ; w3.sender : chainhead address 23334 47747 ; 23335 47747 ; return: 23336 47747 ; w0.sender : result = 0 : chaintable allocated 23337 47747 ; result = 1 : function forbidden in calling process 23338 47747 ; result = 1 : area claims exceeded 23339 47747 ; result = 2 : catalog io-error 23340 47747 ; result = 3 : auxcat name overlap 23341 47747 ; result = 3 : auxcat name already exists 23342 47747 ; result = 4 : document-device does not exist 23343 47747 ; result = 4 : device is not a bs-device 23344 47747 ; result = 4 : device not reserved by calling process 23345 47747 ; result = 5 : auxcat size <= 0 or auxcat size too large 23346 47747 ; result = 5 : chainhead chain inconsistent 23347 47747 ; result = 5 : auxcat chain inconsistent 23348 47747 ; result = 5 : illegal kind of chaintable 23349 47747 ; result = 5 : key illegal 23350 47747 ; result = 5 : too many slices 23351 47747 ; result = 5 : claims exceeded (too few slices for chaintable) 23352 47747 ; result = 5 : claims exceeded (auxcat too large) 23353 47747 ; result = 5 : claims exceeded (no room in maincat) 23354 47747 ; result = 6 : auxcat nameformat illegal 23355 47747 ; result = 6 : docname nameformat illegal 23356 47747 ; result = 7 : no chains idle 23357 47747 b. g10 h. 23358 47747 23358 47747 p51: ; prepare bs: 23359 47747 m8 , f71 ; check function mask (aux catalog handling); 23360 47749 m86 ; move chainhead.sender to work and test auxcat size > 0; 23361 47750 r5. ; auxcat size <= 0: result 5; 23362 47751 ; test the auxcat name: 23363 47751 m70 ; base.work := catalog interval; 23364 47752 m17 ; test new system name (wrk-name not allowed): 23365 47753 r3. ; overlap: result 3; 23366 47754 r3. ; exact : result 3; 23367 47755 ; test the document name: 23368 47755 ; notice: the reservation ensures that the document does not exist 23369 47755 ; already in the bs-system 23370 47755 m85 ; search bs-process and check reserved by sender: 23371 47756 r4. ; not found or not bs or not reserved: result 4; 23372 47757 m70 ; base.work := catalog interval; (because moved again...) 23373 47758 m76 ; test auxkey (and interval); 23374 47759 ; give all claims to sender: 23375 47759 m38 ; find empty chain and prepare; 23376 47760 m20 ; copy chaintable chain; 23377 47761 ; claim the slices used for chaintable: 23378 47761 m25 ; test claims (prepare bs); 23379 47762 r5. ; claims exceeded: result 5; 23380 47763 m19 ; test chain errors; 23381 47764 m21 ; copy chain and cut down (auxcat); 23382 47765 ; claim the slices used for auxcat: 23383 47765 ; (notice: the auxcat itself is not described in any catalog entry) 23384 47765 m25 ; test claims (prepare bs); 23385 47766 r5. ; claims exceeded: result 5; 23386 47767 m19 ; test chain errors; 23387 47768 ; insert in maincat a description of the aux catalog 23388 47768 ; (if maincat does not exist yet, it will take place when 23389 47768 ; the main catalog is connected) 23390 47768 m0 , g5. ; if no maincat yet then goto no maincat; 23391 47770 m31 ; prepare maincat entry; 23392 47771 m30 ; test claims (create): 23393 47772 r5. ; claims exceeded: result 5; 23394 47773 m14 ; compute namekey; 23395 47774 m55 ; find empty entry; 23396 47775 r5. ; no room: result 5; 23397 47776 m56 ; modify cur entry; 23398 47777 g5: ; no maincat: 23399 47777 m40 ; terminate update of new chainhead; 23400 47778 ; notice: now the chain is included is the bs-system 23401 47778 ; (still not ready for normal use) 23402 47778 m37 , t1 ; state.chain := after prepare; 23403 47780 m46 , 0 ; setup area process (procfunc) for auxcat; 23404 47782 m47 , 2 ; include (sender) as user of auxcat area process; 23405 47784 m49 ; let sender be reserver of auxcat area process; 23406 47785 ; (i.e. sender may now make any modifications 23407 47785 ; in the auxcat) 23408 47785 ; (hint: he could have done any damage before he 23409 47785 ; called ..prepare bs.. so why not let him have the 23410 47785 ; advantage of the area-process concept) 23411 47785 j0 ; result ok; 23412 47786 23412 47786 e. ; 23413 47786 23413 47786 23413 47786 23413 47786 ; insert entry 23414 47786 ; 23415 47786 ; call: 23416 47786 ; w1.sender : entry address 23417 47786 ; w3.sender : chainhead address 23418 47786 ; 23419 47786 ; return: 23420 47786 ; w0.sender : result = 0 : entry inserted in main catalog 23421 47786 ; result = 1 : function forbidden in calling process 23422 47786 ; result = 2 : catalog io-error 23423 47786 ; result = 2 : document not found 23424 47786 ; result = 2 : state of document does not permit this call 23425 47786 ; result = 3 : name overlap 23426 47786 ; result = 3 : name already exists 23427 47786 ; result = 4 : calling process is not user of the device 23428 47786 ; result = 5 : key illegal 23429 47786 ; result = 5 : interval illegal 23430 47786 ; result = 5 : chain overlap 23431 47786 ; result = 5 : chain outside limits 23432 47786 ; result = 6 : nameformat illegal 23433 47786 ; result = 6 : docname format illegal 23434 47786 ; result = 6 : claims exceeded 23435 47786 ; result = 7 : maincat not present 23436 47786 ; 23437 47786 ; notice: the claims of the process are ok, when result = 0,3,(5),7 23438 47786 23438 47786 b. g20 h. 23439 47786 23439 47786 p52: ; insert entry: 23440 47786 m8 , f71 ; check function mask (aux catalog handling) 23441 47788 m109 ; move chainhead.sender to work; 23442 47789 m84 ; (size.work := 0;) 23443 47790 m36 , t21 ; search chain (state = allowed for insert entry); 23444 47792 m9 ; check privileges; 23445 47793 m37 , t2 ; state.chain := during insert; 23446 47795 m107 ; move entry.sender to work; 23447 47796 m76 ; test auxkey, interval; 23448 47797 23448 47797 ; notice: if the main catalog has been connected from this 23449 47797 ; document, the chain has already been copied, and 23450 47797 ; entry and slices claimed 23451 47797 m3 ; if main-catalog entry then 23452 47798 r0. ; goto result ok; 23453 47799 23453 47799 m21 ; copy chain (entry) and cut down; 23454 47800 m0 , g20. ; if no maincat then goto claim slices only; 23455 47802 m30 ; test claims (create entry): 23456 47803 r6. ; claims exceeded: result 6; 23457 47804 m19 ; test chain errors; 23458 47805 m17 ; test new system name (wrk-name not allowed): 23459 47806 g15. ; overlap: result 3; 23460 47807 g15. ; exact : result 3; 23461 47808 ; make it easy for changing the name of the document: 23462 47808 m88 , g5. ; if size.work >= 0 then 23463 47810 m66 ; docname.work := docname.chain; 23464 47811 m125, g10. ; else 23465 47813 g5: ; begin 23466 47813 m90 ; (prepare compute docnumber: prevent alarms) 23467 47814 m91 ; first slice.work := compute docnumber; 23468 47815 g10: ; end; 23469 47815 m55 ; find empty entry: 23470 47816 r6. ; no room: result 6; 23471 47817 m56 ; modify cur entry; 23472 47818 j0 ; result ok; 23473 47819 ; 23474 47819 ; entry cannot be inserted in maincat but the entry is already claimed. 23475 47819 ; unclaim 1 entry and 0 slices in main and auxcat and reclaim i entry in auxcat. 23476 47819 23476 47819 g15: m280, r7. ; unclaim entries . (hardly claims exceeded.) 23477 47821 m260, r7. ; claim 1 aux entry. 23478 47823 j3 ; deliver result 3 23479 47824 23479 47824 g20: ; claim slices only: 23480 47824 ; main catalog not present, therefor don't claim a maincat entry 23481 47824 m26 ; test claims (create aux entry); 23482 47825 r6. ; claims exceeded: result 6; 23483 47826 m19 ; test chain errors; 23484 47827 j7 ; result 7; 23485 47828 23485 47828 e. ; 23486 47828 23486 47828 23486 47828 23486 47828 ; insert backing storage 23487 47828 ; 23488 47828 ; call: 23489 47828 ; w2.sender : docname address 23490 47828 ; 23491 47828 ; return: 23492 47828 ; w0.sender : result = 0 : document included is bs-system 23493 47828 ; result = 1 : function forbidden in calling process 23494 47828 ; result = 2 : document not found 23495 47828 ; result = 2 : state of document does not permit this call 23496 47828 ; result = 4 : calling process is not user of device 23497 47828 ; result = 6 : docname format illegal 23498 47828 23498 47828 p53: ; insert bs: 23499 47828 m8 , f71 ; check function mask (aux catalog handling); 23500 47830 m104 ; move docname.sender to docname.work; 23501 47831 m84 ; (size.work := 0;) 23502 47832 m36 , t21 ; search chain (state = allowed for insert bs); 23503 47834 m9 ; check privileges; 23504 47835 m37 , t3 ; state.chain := ready; 23505 47837 j0 ; result ok; 23506 47838 23506 47838 23506 47838 23506 47838 ; delete backing storage 23507 47838 ; 23508 47838 ; call: 23509 47838 ; w2.sender : docname address 23510 47838 ; 23511 47838 ; return: 23512 47838 ; w0.sender : result = 0 : document removed from bs-system 23513 47838 ; result = 1 : function forbidden in calling process 23514 47838 ; result = 2 : catalog io-error 23515 47838 ; result = 2 : document not found 23516 47838 ; result = 4 : calling process is not user of device 23517 47838 ; result = 5 : areaprocesses exists for the document 23518 47838 ; result = 6 : main catalog on the document 23519 47838 ; result = 6 : docname format illegal 23520 47838 23520 47838 p54: ; delete bs: 23521 47838 m8 , f71 ; check function mask (aux catalog handling); 23522 47840 m104 ; move docname.sender to docname.work; 23523 47841 m84 ; (size.work := 0); 23524 47842 m36 , t23 ; search chain (state = allowed for delete bs); 23525 47844 m9 ; check privileges; 23526 47845 m115 ; check any area processes on document; 23527 47846 m1 ; test main catalog not on document; 23528 47847 m116 ; prepare catalog scan; 23529 47848 m37 , t4 ; state.chain := during delete; 23530 47850 23530 47850 ; the following assumes that the disc-driver handles messages: 23531 47850 ; last come => last served 23532 47850 ; a (dummy) message is sent to the aux catalog (in this case an input 23533 47850 ; message, because such a procedure exists), and when the answer 23534 47850 ; arrives, all other area-transfers must have been terminated too. 23535 47850 ; the chaintable may now (soon) be used by another disc, if wanted. 23536 47850 23536 47850 m4 ; set auxcat; 23537 47851 m118 ; (get first auxcat segment); 23538 47852 r0. ; (no entries with namekey = 0, does'nt matter) 23539 47853 23539 47853 j0 ; result ok; 23540 47854 23540 47854 23540 47854 23540 47854 ; delete entries 23541 47854 ; 23542 47854 ; call: 23543 47854 ; w2.sender : docname address 23544 47854 ; 23545 47854 ; return: 23546 47854 ; w0.sender : result = 0 : all entries deleted (from main catalog) 23547 47854 ; and chain released 23548 47854 ; result = 1 : function forbidden in calling process 23549 47854 ; result = 2 : catalog io-error 23550 47854 ; result = 2 : document not found 23551 47854 ; result = 2 : state of document does not permit this call 23552 47854 ; result = 3 : not all entries deleted yet 23553 47854 ; result = 4 : calling process is not user of device 23554 47854 ; result = 6 : docname format illegal 23555 47854 23555 47854 b. g10 h. 23556 47854 23556 47854 p55: ; delete entries: 23557 47854 m8 , f71 ; check function mask (aux catalog handling); 23558 47856 m104 ; move docname.sender to docname.work; 23559 47857 m84 ; (size.work := 0;) 23560 47858 m36 , t4 ; search chain (state = during delete); 23561 47860 m9 ; check privileges; 23562 47861 m0 ; if no maincat then 23563 47862 g10. ; goto clear up; 23564 47863 23564 47863 ; clear a portion of the main catalog for entries belonging to curdoc 23565 47863 m118 ; for all curkey entries in main catalog do 23566 47864 g5. ; begin 23567 47865 m122, g1. ; if entry on document then 23568 47867 m31 ; prepare maincat entry; 23569 47868 m28 ; test claims (remove): 23570 47869 r7. ; claims exceeded: result 7; (not possible) 23571 47870 m120 ; delete entry; 23572 47871 g1: ; 23573 47871 m119 ; end for all entries; 23574 47872 g5: ; 23575 47872 m121 ; update entry count, if any deleted; 23576 47873 m117 ; test more catalog segments to clean: 23577 47874 r3. ; more segments: result 3; 23578 47875 23578 47875 ; all entries, belonging to curdoc, has been removed from main catalog: 23579 47875 g10: ; clear up: 23580 47875 m70 ; base.work := catalog interval; 23581 47876 m67 ; move auxcat name from chain to name.work; 23582 47877 m45 ; search best area process: 23583 47878 r7. ; not found: result 7; (not possible) 23584 47879 m50 ; (if area process then) delete area process; 23585 47880 m41 ; terminate use of chain and disc; 23586 47881 m37 , t0 ; state.chain := idle; 23587 47883 j0 ; result ok; 23588 47884 23588 47884 e. ; 23589 47884 23589 47884 23589 47884 23589 47884 ; connect main catalog 23590 47884 ; 23591 47884 ; call: 23592 47884 ; w1.sender : main catalog name address 23593 47884 ; w3.sender : chainhead address 23594 47884 ; 23595 47884 ; return: 23596 47884 ; w0.sender : result = 0 : main catalog connected 23597 47884 ; result = 1 : function forbidden in calling process 23598 47884 ; result = 1 : area claims exceeded 23599 47884 ; result = 2 : catalog io-error 23600 47884 ; result = 2 : document not found 23601 47884 ; result = 2 : state of document does not permit this call 23602 47884 ; result = 3 : name does not exist in auxcat 23603 47884 ; result = 3 : name overlap 23604 47884 ; result = 3 : name already exists 23605 47884 ; result = 4 : calling process is not user of device 23606 47884 ; result = 5 : maincat size <= 0 or maincat size too large 23607 47884 ; result = 5 : key illegal 23608 47884 ; result = 5 : interval illegal 23609 47884 ; result = 5 : chain overlap 23610 47884 ; result = 5 : chain outside limits 23611 47884 ; result = 6 : claims exceeded 23612 47884 ; result = 6 : docname format illegal 23613 47884 ; result = 7 : main catalog already present 23614 47884 23614 47884 b. g10 h. 23615 47884 23615 47884 p56: ; connect main catalog: 23616 47884 m8 , f72 ; check function mask (main catalog handling); 23617 47886 m0 , g1. ; if maincat already exists then 23618 47888 j7 ; result 7; 23619 47889 g1: ; 23620 47889 m109 ; move chainhead.sender to work; 23621 47890 m84 ; (size.work := 0;) 23622 47891 m36 , t21 ; search chain (state = allowed for connect catalog); 23623 47893 m9 ; check privileges; 23624 47894 ; prepare a search in auxcat for a main catalog: 23625 47894 m103 ; move catalog name.sender to name.work; 23626 47895 m70 ; base.work := catalog interval; 23627 47896 m17 ; test new system name (wrk-name not allowed): 23628 47897 r3. ; overlap: result 3; 23629 47898 r3. ; exact : result 3; 23630 47899 m4 ; set auxcat; 23631 47900 m10 ; search best entry (in aux catalog): 23632 47901 r3. ; not found: result 3; 23633 47902 m87 ; if size.work <= 0 then 23634 47903 r5. ; result 5; 23635 47904 m76 ; test auxkey (and interval); 23636 47905 m37 , t2 ; state.chain := during insert; 23637 47907 m21 ; copy chain and cut down; 23638 47908 ; claim an auxcat entry and the slices used for main catalog 23639 47908 m26 ; set claims (create aux entry): 23640 47909 r6. ; claims exceeded : result 6; 23641 47910 m19 ; test chain errors; 23642 47911 m66 ; docname.work := docname.curdoc; 23643 47912 m46 , 0 ; setup area process (procfunc) for main catalog area; 23644 47914 m39 ; set maincat and prepare claims; 23645 47915 m5 ; set maincat; 23646 47916 m42 ; clean main catalog; 23647 47917 m67 ; move auxcat name from chain to name.work; 23648 47918 m70 ; base.work := catalog interval; 23649 47919 m45 ; search best area process: 23650 47920 r7. ; not found: result 7; (not possible) 23651 47921 m47 , 2 ; include (sender) as user of auxcat area process; 23652 47923 m49 ; let sender be reserver of auxcat area process; 23653 47924 ; (see the hint in ..prepare backing storage..) 23654 47924 23654 47924 ; insert all existing chainheads in main catalog 23655 47924 m123 ; for all existing chaintables do 23656 47925 r0. ; begin 23657 47926 m31 ; prepare maincat entry; 23658 47927 m30 ; test claims (create); 23659 47928 r6. ; claims exceeded: result 6; 23660 47929 m70 ; base.work := catalog interval; 23661 47930 m14 ; compute namekey; 23662 47931 m55 ; find empty entry: 23663 47932 r6. ; no room: result 6; 23664 47933 m56 ; modify cur entry; 23665 47934 m119 ; end for; 23666 47935 ; result ok; 23667 47935 23667 47935 e. ; 23668 47936 23668 47936 23668 47936 23668 47936 ; remove main catalog 23669 47936 ; 23670 47936 ; return: 23671 47936 ; w0.sender : result = 0 : main catalog removed 23672 47936 ; result = 7 : main catalog not present 23673 47936 23673 47936 p57: ; remove main catalog: 23674 47936 m8 , f72+f71; check function mask (main catalog handling); 23675 47938 m0 , r7. ; if no maincat then result 7; 23676 47940 m68 ; move maincat name from pseudo chainhead to name.work; 23677 47941 m70 ; base.work := catalog interval; 23678 47942 m45 ; search best area process: 23679 47943 r7. ; not found: result 7; (not possible) 23680 47944 m50 ; (if area process then) delete area process; 23681 47945 m4 ; set auxcat; (i.e. prevent further use of main catalog) 23682 47946 m2 ; clear maincat; 23683 47947 j0 ; result ok; 23684 47948 23684 47948 23684 47948 23684 47948 ; create aux entry and area process 23685 47948 ; 23686 47948 ; call: 23687 47948 ; w1.sender : entry address 23688 47948 ; w2.sender : docname address 23689 47948 ; w3.sender : procname address 23690 47948 ; 23691 47948 ; return: 23692 47948 ; w0.sender : result = 0 : entry and areaprocess created 23693 47948 ; result = 1 : function forbidden in calling process 23694 47948 ; result = 1 : area claims exceeded 23695 47948 ; result = 2 : catalog io-error 23696 47948 ; result = 2 : document not found 23697 47948 ; result = 2 : state of document does not permit this call 23698 47948 ; result = 3 : procname overlap 23699 47948 ; result = 3 : procname already exists 23700 47948 ; result = 3 : entryname overlap (in auxcat) 23701 47948 ; result = 3 : entryname already exists (in auxcat) 23702 47948 ; result = 4 : calling process is not user of device 23703 47948 ; result = 4 : claims exceeded 23704 47948 ; result = 5 : key illegal 23705 47948 ; result = 5 : interval illegal 23706 47948 ; result = 6 : entryname format illegal 23707 47948 ; result = 6 : procname format illegal 23708 47948 ; result = 6 : docname format illegal 23709 47948 23709 47948 b. g10 h. 23710 47948 23710 47948 p60: ; create aux entry and area process: 23711 47948 m8 , f76 ; check function mask (create aux entry); 23712 47950 m104 ; move docname.sender to docname.work; 23713 47951 m84 ; (size.work := 0;) 23714 47952 m36 , t28 ; search chain (state = allowed for create aux); 23715 47954 m9 ; check privileges; 23716 47955 m107 ; move entry.sender to work; 23717 47956 m90 ; first slice.work := 0; 23718 47957 m88 , g1. ; if size.work >= 0 then 23719 47959 m66 ; docname.work := docname.chain; 23720 47960 g1: ; 23721 47960 m76 ; test auxkey and interval; 23722 47961 ; scan the auxcat to see if the new entry may be created: 23723 47961 m4 ; set auxcat; 23724 47962 m18 ; test new catalog name (in auxcat): 23725 47963 r3. ; overlap: result 3; 23726 47964 r3. ; exact : result 3; 23727 47965 m37 , t6 ; state.chain := during aux entry manipulation; 23728 47967 m22 , 2.10 ; compute slices to claim (compute new slices); 23729 47969 m26 ; test claims (create aux entry): 23730 47970 r4. ; claims exceeded: result 4; 23731 47971 m23 ; adjust chain to size; 23732 47972 m55 ; find empty entry: 23733 47973 r4. ; no room: result 4; 23734 47974 m6 ; dump chaintable; 23735 47975 m60 ; clear access counters.work; 23736 47976 m56 ; modify current entry; 23737 47977 m88 , g2. ; if size.work>=0 then 23738 47979 m62 ; update and insert statarea; 23739 47980 g2: ; 23740 47980 ; prepare for testing of the area-process name: 23741 47980 m5 ; set maincat; 23742 47981 m100 ; move name.sender to name.work; (i.e. get procname) 23743 47982 m15 ; test new system name (wrk-name allowed): 23744 47983 r3. ; overlap: result 3; 23745 47984 r3. ; exact : result 3; 23746 47985 m46 , 2 ; setup area process (sender); 23747 47987 m49 ; let sender be reserver of the area-process; 23748 47988 m101 ; move name.work back to name.sender (if wrk-name); 23749 47989 j0 ; result ok; 23750 47990 23750 47990 e. ; 23751 47990 23751 47990 23751 47990 23751 47990 ; remove aux entry 23752 47990 ; 23753 47990 ; call: 23754 47990 ; w1.sender : entry address 23755 47990 ; w2.sender : docname address 23756 47990 ; 23757 47990 ; return: 23758 47990 ; w0.sender : result = 0 : aux entry removed 23759 47990 ; result = 1 : function forbidden in calling process 23760 47990 ; result = 2 : catalog io-error 23761 47990 ; result = 2 : document not found 23762 47990 ; result = 2 : state of document does not permit this call 23763 47990 ; result = 3 : entry does not exist (in auxcat) 23764 47990 ; result = 6 : entry nameformat illegal 23765 47990 ; result = 6 : docname format illegal 23766 47990 23766 47990 p61: ; remove aux entry: 23767 47990 m8 , f76 ; check function mask (create aux); 23768 47992 m104 ; move docname.sender to docname.work; 23769 47993 m84 ; (size.work := 0;) 23770 47994 m36 , t28 ; search chain (state = allowed for aux entry manipulation 23771 47996 m9 ; test privileges; 23772 47997 m4 ; set auxcat; 23773 47998 m107 ; move entry.sender to work; 23774 47999 ; notice: there is no check upon legality of interval 23775 47999 m10 ; search best entry (in auxcat): 23776 48000 r3. ; not found: result 3; 23777 48001 ; notice: it is not checked that it was the rigth entry (i.e. same base) 23778 48001 m37 , t4 ; state.chain := during aux entry manipulation; 23779 48003 m57 ; delete cur entry; 23780 48004 ; notice: the entry- and slice-claims are not released, nor is the slice-chain 23781 48004 j0 ; result ok; 23782 48005 23782 48005 ; lookup aux entry 23783 48005 ; 23784 48005 ; call: 23785 48005 ; w1.sender : tail address 23786 48005 ; w2.sender : docname address 23787 48005 ; w3.sender : name address 23788 48005 ; 23789 48005 ; return: 23790 48005 ; w0.sender : result = 0 : entry looked up 23791 48005 ; result = 2 : catalog input-output error 23792 48005 ; result = 2 : document not ready( or does not exist 23793 48005 ; result = 3 : entry not found 23794 48005 ; result = 6 : name format illegal 23795 48005 ; result = 7 : maincat not present 23796 48005 23796 48005 p43: ; lookup auxentry: 23797 48005 m0 , r7. ; check maincat 23798 48007 m65 ; move catbase.name to work 23799 48008 m104 ; move docname.sender to docname.work 23800 48009 m84 ; size.work:=0 23801 48010 m36 , t3 ; search chain (state ready) 23802 48012 m4 ; set auxcat 23803 48013 m100 ; move entry.sender to entry.work 23804 48014 m10 ; seach best entry 23805 48015 r3. ; not found result 3 23806 48016 m106 ; move tail.sender to tail.sender 23807 48017 m5 ; set main cat 23808 48018 j0 ; result ok 23809 48019 23809 48019 ; clear statistics in aux entry 23810 48019 ; 23811 48019 ; call: 23812 48019 ; w2.sender : dacname address 23813 48019 ; w3.sender : name address 23814 48019 ; 23815 48019 ; return: 23816 48019 ; w0.sender : result = 0 : the statistiks of the entry is initialised 23817 48019 ; result = 2 : catalog input/output error 23818 48019 ; result = 2 : document not ready(or does not exist) 23819 48019 ; result = 3 : entry not found; name conflict(in auxcat) 23820 48019 ; result = 6 : name format illegal; claims exceeded 23821 48019 ; result = 7 : maincat not present 23822 48019 b.g10 h. 23823 48019 23823 48019 p44: ; 23824 48019 m0 , r7. ; if no maincat then result 7 23825 48021 m65 ; move catbase.sender to work 23826 48022 m104 ; move docname.sender to docname.work 23827 48023 m84 ; size.work:=0 23828 48024 m36 , t3 ; search chain (state ready) 23829 48026 m4 ; set aux cat 23830 48027 m100 ; move entry.sender to entry.work 23831 48028 m10 ; search best entry 23832 48029 r3. ; not found result 3 23833 48030 m88 , g0. ; if size.work>=0 then 23834 48032 m64 ; move statarea.entry to statarea.work 23835 48033 m60 ; clear access counters.work 23836 48034 m63 ; move statarea.work to statarea.entry 23837 48035 g0: ; 23838 48035 m5 ; set main cat 23839 48036 j0 ; result ok 23840 48037 e. 23841 48038 \f 23841 48038 23841 48038 23841 48038 23841 48038 23841 48038 n49: ; start of monitor call-table: 23842 48038 p20., p21., p22., p23., p24., p25., p26., p27., p28., p29., 23843 48048 p30., p31., p32., r7. , p34., p35., p36., p37., p38., p39., 23844 48058 p40., r7. , p42., p43., p44. , p45., p46., r7. , r7. , r7. , 23845 48068 r7. , p51., p52., p53., p54., p55., p56., p57., r7. , r7. , 23846 48078 p60., p61., 23847 48080 w. 23848 48080 23848 48080 j0 = j0+n50 , j1 = j1+n50 , j2 = j2+n50 , j3 = j3+n50 , j4 = j4+n50 , 23849 48080 j5 = j5+n50 , j6 = j6+n50 , j7 = j7+n50 23850 48080 23850 48080 23850 48080 23850 48080 23850 48080 ; record cat buf: 23851 48080 ; this record holds the current catalog segment. if its content is 23852 48080 ; changed, then the segment is rewritten onto the backing store at 23853 48080 ; the very end of all process function actions. 23854 48080 23854 48080 d0: -1, r.f9>1 ; cat buf (0:size-2); 23855 48590 d18: 0 ; last word of cat buf. 23856 48592 d19 = d0 - 2 + f10*f0 ; abs addr of last word of last entry 23857 48592 ; in cat buf. 23858 48592 23858 48592 c.(:a92>22a.1:)-1 23859 48592 m. procfunc testbuffer, start 23860 48592 d49=k, 0, r.100, d50=k 23861 48592 m. procfunc testbuffer, top 23862 48592 z. 23863 48592 23863 48592 ; interrupt address (used during debugging): 23864 48592 ; proc func is entered here after programming errors. 23865 48592 23865 48592 c. (:a92>21a.1:) -1 23866 48592 e30: 0, r.a180>1 ; ia: save for registers; 23867 48608 al. w1 e30. ; if included print then 23868 48610 rl w0 x1+0 ; begin 23869 48612 jd 1<11+28 ; for i:=ia step 2 until ia+12 do 23870 48614 al w1 x1+2 ; print w (word(i)); 23871 48616 sh. w1 e30.+a180-2 ; wait forever in disabled mode; 23872 48618 jl. -8 ; 23873 48620 jl. (2) 23874 48622 j7 23875 48624 z.c. -(:a92>21a.1:) ; else 23876 48624 e30 = 0,z. ; ia:= 0; 23877 48624 23877 48624 ; code for printing of proc func variables during debugging: 23878 48624 e28: c.(:a92>19a.1:) -1 ; if test call included 23879 48624 b. g24 ; then begin 23880 48624 w. jl. x1+g0. ; goto case print param of ( 23881 48624 g0: jl. (g17.) ; 0: error 7, 23882 48624 jl. g1. ; 2: print cur entry, 23883 48624 jl. (g17.) ; 4: print pf variables); 23884 48624 23884 48624 g1: rl. w3 (g13.) ; print cur entry: 23885 48624 al w2 x3+f0 ; for addr:= cur entry addr 23886 48624 g3: rl w1 x3 ; step 2 until cur entry addr+entry size 23887 48624 jd 1<11+30 ; do print x (word(addr)); 23888 48624 al w3 x3+2 ; 23889 48624 sh w3 x2 ; 23890 48624 jl. g3. ; 23891 48624 jl. (g11.) ; goto error 1; 23892 48624 23892 48624 g11: j1, g17: j7, g13: d3, 23893 48624 e.z. ; end; 23894 48624 23894 48624 ; define the last b-names: 23895 48624 23895 48624 b61 = k ; top address.proc func 23896 48624 b62 = e30 ; interrupt address.proc func 23897 48624 b63 = j10+2 ; waiting point 23898 48624 i. ; id list of process functions 23899 48624 23899 48624 ; after loading: 23900 48624 b. g0 ; begin 23901 48624 w.g0:al. w2 g0. ; define last: 23902 48626 jl x3 ; autoload(next segment,top proc func); 23903 48628 23903 48628 jd. g0. ; after loading: goto define last; 23904 48630 e. ; end. the load code is removed; 23905 48630 j21=k - b127 + 2 23906 48630 23906 48630 k = b61 ; top proc func 23907 48624 e. ; end proc func segment 23908 48624 23908 48624 ; segment 7: Initialize process functions 23909 48624 ; this segment initializes the process descriptions for the first internal 23910 48624 ; process (proc func). it is executed and then removed 23911 48624 ; immediately after loading. 23912 48624 23912 48624 s. g6 ; begin init proc func: 23913 48624 w.b127=k, g6, k=k-2 23914 48624 23914 48624 g0: al. w2 g0. ; after load: load address := top of procfunc; 23915 48626 jl x3 ; goto autoloader; 23916 48628 jl. g0. ; entry from autoloader: goto after load; 23917 48630 g6= k - b127 + 2 23918 48630 23918 48630 k = b61 ; k= first after proc func; 23919 48624 e. ; end init proc func 23920 48624 \f 23920 48624 ▶EOF◀