cdc:nos2.source:opl.opl871:deck:sslabel.002
Deck SSLABEL Part 002
1 Modification
Listing Sections
- Deck SSLABEL Start
- Deck SSLABEL Part 1 (Line 2138)
- Deck SSLABEL Part 2 (Line 4385)
- Deck SSLABEL Part 3 (Line 6626)
Source
Seq # *Modification Id* Act ----------------------------+ 04385 M01S04385.sslabel +++| ERRCODE = S"PK$PT$VIOL"; # "PK,PT OPTION VIOLATED" # 04386 M01S04386.sslabel +++| LBERR(ERRCODE); 04387 M01S04387.sslabel +++| ERRFLAG = 1; 04388 M01S04388.sslabel +++| RETURN; 04389 M01S04389.sslabel +++| END 04390 M01S04390.sslabel +++| 04391 M01S04391.sslabel +++|# 04392 M01S04392.sslabel +++|* CHECK FOR A LEGAL VALUE FOR *PT*. 04393 M01S04393.sslabel +++|# 04394 M01S04394.sslabel +++| 04395 M01S04395.sslabel +++| IF LBARG$PT[0] NQ "P" ## 04396 M01S04396.sslabel +++| AND LBARG$PT[0] NQ "D" ## 04397 M01S04397.sslabel +++| AND LBARG$PT[0] NQ "F" ## 04398 M01S04398.sslabel +++| AND LBARG$PT[0] NQ "R" 04399 M01S04399.sslabel +++| THEN 04400 M01S04400.sslabel +++| BEGIN 04401 M01S04401.sslabel +++| ERRCODE = S"PK$PT$VIOL"; # "PK,PT OPTION VIOLATED" # 04402 M01S04402.sslabel +++| LBERR(ERRCODE); 04403 M01S04403.sslabel +++| ERRFLAG = 1; 04404 M01S04404.sslabel +++| RETURN; 04405 M01S04405.sslabel +++| END 04406 M01S04406.sslabel +++| 04407 M01S04407.sslabel +++|# 04408 M01S04408.sslabel +++|* CHECK IF *CN* IS SPECIFIED CORRECTLY. 04409 M01S04409.sslabel +++|# 04410 M01S04410.sslabel +++| 04411 M01S04411.sslabel +++| IF LBARG$C[0] NQ 0 ## 04412 M01S04412.sslabel +++| AND (LBARG$OP[0] EQ "AS" OR LBARG$OP[0] EQ "RS" OR LBARG$OP[0] 04413 M01S04413.sslabel +++| EQ "AB" ## 04414 M01S04414.sslabel +++| OR LBARG$OP[0] EQ "RB") 04415 M01S04415.sslabel +++| THEN 04416 M01S04416.sslabel +++| BEGIN 04417 M01S04417.sslabel +++| ERRCODE = S"CSN$VIOL"; # "VSN OPTION VIOLATED" # 04418 M01S04418.sslabel +++| LBERR(ERRCODE); 04419 M01S04419.sslabel +++| ERRFLAG = 1; 04420 M01S04420.sslabel +++| RETURN; 04421 M01S04421.sslabel +++| END 04422 M01S04422.sslabel +++| 04423 M01S04423.sslabel +++|# 04424 M01S04424.sslabel +++|* CHECK IF *CM* PARAMETER IS SPECIFIED CORRECTLY. 04425 M01S04425.sslabel +++|# 04426 M01S04426.sslabel +++| 04427 M01S04427.sslabel +++| IF (LBARG$CM[0] NQ IBMCART ## 04428 M01S04428.sslabel +++| AND LBARG$C[0] NQ 0) ## 04429 M01S04429.sslabel +++| OR LBARG$CM[0] NQ IBMCART 04430 M01S04430.sslabel +++| THEN 04431 M01S04431.sslabel +++| BEGIN 04432 M01S04432.sslabel +++| ERRCODE = S"CSN$VIOL"; # *CSN* OPTION VIOLATED # 04433 M01S04433.sslabel +++| LBERR(ERRCODE); 04434 M01S04434.sslabel +++| ERRFLAG = 1; 04435 M01S04435.sslabel +++| RETURN; 04436 M01S04436.sslabel +++| END 04437 M01S04437.sslabel +++| 04438 M01S04438.sslabel +++|# 04439 M01S04439.sslabel +++|* CHECK *N* OR *PK* IS SPECIFIED WHEN 04440 M01S04440.sslabel +++|* *V* IS SPECIFIED. 04441 M01S04441.sslabel +++|# 04442 M01S04442.sslabel +++| 04443 M01S04443.sslabel +++| IF LBARG$C[0] NQ 0 ## 04444 M01S04444.sslabel +++| AND (LBARG$N[0] NQ 1 ## 04445 M01S04445.sslabel +++| OR LBARG$PK[0] NQ 0) 04446 M01S04446.sslabel +++| THEN 04447 M01S04447.sslabel +++| BEGIN 04448 M01S04448.sslabel +++| ERRCODE = S"CSN$VIOL"; # "VSN OPTION VIOLATED" # 04449 M01S04449.sslabel +++| LBERR(ERRCODE); 04450 M01S04450.sslabel +++| ERRFLAG = 1; 04451 M01S04451.sslabel +++| RETURN; 04452 M01S04452.sslabel +++| END 04453 M01S04453.sslabel +++| 04454 M01S04454.sslabel +++|# 04455 M01S04455.sslabel +++|* CHECK IF *PT* IS SPECIFIED TO BE *P* 04456 M01S04456.sslabel +++|* WHEN *V* IS SPECIFIED FOR *AM*. 04457 M01S04457.sslabel +++|# 04458 M01S04458.sslabel +++| 04459 M01S04459.sslabel +++| IF LBARG$C[0] NQ 0 ## 04460 M01S04460.sslabel +++| AND LBARG$OP[0] EQ "AM" ## 04461 M01S04461.sslabel +++| AND LBARG$PT[0] EQ "P" 04462 M01S04462.sslabel +++| THEN 04463 M01S04463.sslabel +++| BEGIN 04464 M01S04464.sslabel +++| ERRCODE = S"PK$PT$VIOL"; # "PK,PT OPTION VIOLATED" # 04465 M01S04465.sslabel +++| LBERR(ERRCODE); 04466 M01S04466.sslabel +++| ERRFLAG = 1; 04467 M01S04467.sslabel +++| RETURN; 04468 M01S04468.sslabel +++| END 04469 M01S04469.sslabel +++| 04470 M01S04470.sslabel +++|# 04471 M01S04471.sslabel +++|* CHECK IF *PK* AND *PT* ARE SPECIFIED 04472 M01S04472.sslabel +++|* CORRECTLY FOR *AM*. 04473 M01S04473.sslabel +++|# 04474 M01S04474.sslabel +++| 04475 M01S04475.sslabel +++| IF LBARG$OP[0] EQ "AM" ## 04476 M01S04476.sslabel +++| AND LBARG$CC[0] EQ -1 AND ((LBARG$PK[0] NQ 0 ## 04477 M01S04477.sslabel +++| AND LBARG$PK[0] NQ "D" ## 04478 M01S04478.sslabel +++| AND LBARG$PK[0] NQ "P") ## 04479 M01S04479.sslabel +++| OR (LBARG$PT[0] NQ "P" ## 04480 M01S04480.sslabel +++| AND LBARG$PT[0] NQ "F")) 04481 M01S04481.sslabel +++| THEN 04482 M01S04482.sslabel +++| BEGIN 04483 M01S04483.sslabel +++| ERRCODE = S"PK$PT$VIOL"; # "PK,PT OPTION VIOLATED" # 04484 M01S04484.sslabel +++| LBERR(ERRCODE); 04485 M01S04485.sslabel +++| ERRFLAG = 1; 04486 M01S04486.sslabel +++| RETURN; 04487 M01S04487.sslabel +++| END 04488 M01S04488.sslabel +++| 04489 M01S04489.sslabel +++|# 04490 M01S04490.sslabel +++|* CHECK IF *PK* AND *PT* ARE SPECIFIED 04491 M01S04491.sslabel +++|* CORRECTLY FOR *RM*. 04492 M01S04492.sslabel +++|# 04493 M01S04493.sslabel +++| 04494 M01S04494.sslabel +++| IF LBARG$OP[0] EQ "RM" ## 04495 M01S04495.sslabel +++| AND ((LBARG$PK[0] NQ 0 ## 04496 M01S04496.sslabel +++| AND LBARG$PK[0] NQ "P" ## 04497 M01S04497.sslabel +++| AND LBARG$PK[0] NQ "F") ## 04498 M01S04498.sslabel +++| OR (LBARG$PT[0] NQ "D" ## 04499 M01S04499.sslabel +++| AND LBARG$PT[0] NQ "P")) 04500 M01S04500.sslabel +++| THEN 04501 M01S04501.sslabel +++| BEGIN 04502 M01S04502.sslabel +++| ERRCODE = S"PK$PT$VIOL"; # "PK,PT OPTION VIOLATED" # 04503 M01S04503.sslabel +++| LBERR(ERRCODE); 04504 M01S04504.sslabel +++| ERRFLAG = 1; 04505 M01S04505.sslabel +++| RETURN; 04506 M01S04506.sslabel +++| END 04507 M01S04507.sslabel +++| 04508 M01S04508.sslabel +++|# 04509 M01S04509.sslabel +++|* CHECK IF *PK* IS SPECIFIED CORRECTLY 04510 M01S04510.sslabel +++|* FOR *RB*. 04511 M01S04511.sslabel +++|# 04512 M01S04512.sslabel +++| 04513 M01S04513.sslabel +++| IF LBARG$OP[0] EQ "RB" ## 04514 M01S04514.sslabel +++| AND (LBARG$PK[0] NQ "P" ## 04515 M01S04515.sslabel +++| AND LBARG$PK[0] NQ "F" ## 04516 M01S04516.sslabel +++| AND LBARG$PK[0] NQ "R") 04517 M01S04517.sslabel +++| THEN 04518 M01S04518.sslabel +++| BEGIN 04519 M01S04519.sslabel +++| ERRCODE = S"PK$PT$VIOL"; # "PK,PT OPTION VIOLATED" # 04520 M01S04520.sslabel +++| LBERR(ERRCODE); 04521 M01S04521.sslabel +++| ERRFLAG = 1; 04522 M01S04522.sslabel +++| RETURN; 04523 M01S04523.sslabel +++| END 04524 M01S04524.sslabel +++| 04525 M01S04525.sslabel +++|# 04526 M01S04526.sslabel +++|* CHECK IF *PK* AND *PT* ARE BOTH SPECIFIED 04527 M01S04527.sslabel +++|* TO BE *P* FOR *AM* OR *RM*. 04528 M01S04528.sslabel +++|# 04529 M01S04529.sslabel +++| 04530 M01S04530.sslabel +++| IF (LBARG$PK[0] EQ "P" ## 04531 M01S04531.sslabel +++| AND LBARG$PT[0] EQ "P") ## 04532 M01S04532.sslabel +++| AND LBARG$CC[0] EQ -1 ## 04533 M01S04533.sslabel +++| AND (LBARG$OP[0] EQ "AM" ## 04534 M01S04534.sslabel +++| OR LBARG$OP[0] EQ "RM") 04535 M01S04535.sslabel +++| THEN 04536 M01S04536.sslabel +++| BEGIN 04537 M01S04537.sslabel +++| ERRCODE = S"PK$PT$VIOL"; # "PK,PT OPTION VIOLATED" # 04538 M01S04538.sslabel +++| LBERR(ERRCODE); 04539 M01S04539.sslabel +++| ERRFLAG = 1; 04540 M01S04540.sslabel +++| RETURN; 04541 M01S04541.sslabel +++| END 04542 M01S04542.sslabel +++| 04543 M01S04543.sslabel +++|# 04544 M01S04544.sslabel +++|* CHECK IF *PT* IS SPECIFIED CORRECTLY FOR *AB*. 04545 M01S04545.sslabel +++|# 04546 M01S04546.sslabel +++| 04547 M01S04547.sslabel +++| IF LBARG$OP[0] EQ "AB" ## 04548 M01S04548.sslabel +++| AND ((LBARG$PT[0] EQ "D") ## 04549 M01S04549.sslabel +++| OR (LBARG$N[0] NQ 1 ## 04550 M01S04550.sslabel +++| AND LBARG$PT[0] EQ "R")) 04551 M01S04551.sslabel +++| THEN 04552 M01S04552.sslabel +++| BEGIN 04553 M01S04553.sslabel +++| ERRCODE = S"PK$PT$VIOL"; # "PK,PT OPTION VIOLATED" # 04554 M01S04554.sslabel +++| LBERR(ERRCODE); 04555 M01S04555.sslabel +++| ERRFLAG = 1; 04556 M01S04556.sslabel +++| RETURN; 04557 M01S04557.sslabel +++| END 04558 M01S04558.sslabel +++| 04559 M01S04559.sslabel +++|# 04560 M01S04560.sslabel +++|* CHECK IF *YI*, *ZI* OPTION IS SELECTED FOR *AB*. 04561 M01S04561.sslabel +++|# 04562 M01S04562.sslabel +++| 04563 M01S04563.sslabel +++| IF LBARG$OP[0] EQ "AB" ## 04564 M01S04564.sslabel +++| AND LBARG$PT[0] EQ "R" ## 04565 M01S04565.sslabel +++| AND LBARG$YI[0] EQ -1 ## 04566 M01S04566.sslabel +++| AND LBARG$ZI[0] EQ -1 04567 M01S04567.sslabel +++| THEN 04568 M01S04568.sslabel +++| BEGIN 04569 M01S04569.sslabel +++| ERRCODE = S"YZ$VIOL"; # "Y,Z OPTION VIOLATED" # 04570 M01S04570.sslabel +++| LBERR(ERRCODE); 04571 M01S04571.sslabel +++| ERRFLAG = 1; 04572 M01S04572.sslabel +++| RETURN; 04573 M01S04573.sslabel +++| END 04574 M01S04574.sslabel +++| 04575 M01S04575.sslabel +++|# 04576 M01S04576.sslabel +++|* CHECK IF *YI*, *ZI* OPTION IS IMPROPERLY USED FOR *AM*. 04577 M01S04577.sslabel +++|# 04578 M01S04578.sslabel +++| 04579 M01S04579.sslabel +++| IF LBARG$OP[0] EQ "AM" ## 04580 M01S04580.sslabel +++| AND (LBARG$YI[0] NQ -1 ## 04581 M01S04581.sslabel +++| OR LBARG$ZI[0] NQ -1) ## 04582 M01S04582.sslabel +++| AND LBARG$CC[0] EQ -1 04583 M01S04583.sslabel +++| THEN 04584 M01S04584.sslabel +++| BEGIN 04585 M01S04585.sslabel +++| ERRCODE = S"YZ$VIOL"; # "Y,Z OPTION VIOLATED" # 04586 M01S04586.sslabel +++| LBERR(ERRCODE); 04587 M01S04587.sslabel +++| ERRFLAG = 1; 04588 M01S04588.sslabel +++| RETURN; 04589 M01S04589.sslabel +++| END 04590 M01S04590.sslabel +++| 04591 M01S04591.sslabel +++| 04592 M01S04592.sslabel +++|# 04593 M01S04593.sslabel +++|* CHECK IF *LOST OPTION* IS SPECIFIED CORRECTLY. 04594 M01S04594.sslabel +++|# 04595 M01S04595.sslabel +++| 04596 M01S04596.sslabel +++| IF LBARG$LT[0] NQ 0 ## 04597 M01S04597.sslabel +++| AND (LBARG$OP[0] NQ "RM" ## 04598 M01S04598.sslabel +++| OR LBARG$C[0] EQ 0) ## 04599 M01S04599.sslabel +++| THEN 04600 M01S04600.sslabel +++| BEGIN 04601 M01S04601.sslabel +++| ERRCODE = S"LT$VIOL"; # "LT OPTION VIOLATED" # 04602 M01S04602.sslabel +++| LBERR(ERRCODE); 04603 M01S04603.sslabel +++| ERRFLAG = 1; 04604 M01S04604.sslabel +++| RETURN; 04605 M01S04605.sslabel +++| END 04606 M01S04606.sslabel +++| 04607 M01S04607.sslabel +++|# 04608 M01S04608.sslabel +++|* CHECK IF GROUP NUMBER IS LEGAL. 04609 M01S04609.sslabel +++|# 04610 M01S04610.sslabel +++| 04611 M01S04611.sslabel +++| IF ((LBARG$GR[0] GQ 0) ## 04612 M01S04612.sslabel +++| AND ((LBARG$OP[0] EQ "AS") ## 04613 M01S04613.sslabel +++| OR (LBARG$OP[0] EQ "AB") ## 04614 M01S04614.sslabel +++| OR (LBARG$OP[0] EQ "RS") ## 04615 M01S04615.sslabel +++| OR (LBARG$OP[0] EQ "RB") ## 04616 M01S04616.sslabel +++| OR (LBARG$OP[0] EQ "FX") ## 04617 M01S04617.sslabel +++| OR (LBARG$OP[0] EQ "RC") ## 04618 M01S04618.sslabel +++| OR (LBARG$OP[0] EQ "IB"))) 04619 M01S04619.sslabel +++| THEN # INCORRECT USE OF GROUP # 04620 M01S04620.sslabel +++| BEGIN 04621 M01S04621.sslabel +++| ERRCODE = S"GR$INCORR"; 04622 M01S04622.sslabel +++| LBERR(ERRCODE); 04623 M01S04623.sslabel +++| ERRFLAG = 1; 04624 M01S04624.sslabel +++| RETURN; 04625 M01S04625.sslabel +++| END 04626 M01S04626.sslabel +++| 04627 M01S04627.sslabel +++| IF LBARG$GR[0] GR 20 04628 M01S04628.sslabel +++| OR LBARG$GR[0] EQ 0 04629 M01S04629.sslabel +++| THEN # GROUP OUT OF RANGE # 04630 M01S04630.sslabel +++| BEGIN 04631 M01S04631.sslabel +++| ERRCODE = S"GR$RANGE"; 04632 M01S04632.sslabel +++| LBERR(ERRCODE); 04633 M01S04633.sslabel +++| ERRFLAG = 1; 04634 M01S04634.sslabel +++| RETURN; 04635 M01S04635.sslabel +++| END 04636 M01S04636.sslabel +++| 04637 M01S04637.sslabel +++| 04638 M01S04638.sslabel +++|# 04639 M01S04639.sslabel +++|* CHECK IF *PT* IS *P* AND *OP* IS *AM* WITH *GR* SPECIFIED. 04640 M01S04640.sslabel +++|# 04641 M01S04641.sslabel +++| 04642 M01S04642.sslabel +++| IF LBARG$GR[0] GQ 0 AND LBARG$OP[0] EQ "AM" AND LBARG$PT[0] EQ "P 04643 M01S04643.sslabel +++| " 04644 M01S04644.sslabel +++| THEN 04645 M01S04645.sslabel +++| BEGIN 04646 M01S04646.sslabel +++| ERRCODE = S"GR$INCORR"; 04647 M01S04647.sslabel +++| LBERR(ERRCODE); 04648 M01S04648.sslabel +++| ERRFLAG = 1; 04649 M01S04649.sslabel +++| RETURN; 04650 M01S04650.sslabel +++| END 04651 M01S04651.sslabel +++| 04652 M01S04652.sslabel +++| 04653 M01S04653.sslabel +++|# 04654 M01S04654.sslabel +++|* CHECK IF *CN* IS SPECIFIED FOR *IB* AND *FX*. 04655 M01S04655.sslabel +++|# 04656 M01S04656.sslabel +++| 04657 M01S04657.sslabel +++| IF (LBARG$OP[0] EQ "IB" ## 04658 M01S04658.sslabel +++| OR LBARG$OP[0] EQ "FX") ## 04659 M01S04659.sslabel +++| AND LBARG$C[0] EQ 0 04660 M01S04660.sslabel +++| THEN 04661 M01S04661.sslabel +++| BEGIN 04662 M01S04662.sslabel +++| ERRCODE = S"CSN$VIOL"; # VSN OPTION VIOLATED # 04663 M01S04663.sslabel +++| LBERR(ERRCODE); 04664 M01S04664.sslabel +++| ERRFLAG = 1; 04665 M01S04665.sslabel +++| RETURN; 04666 M01S04666.sslabel +++| END 04667 M01S04667.sslabel +++| 04668 M01S04668.sslabel +++|# 04669 M01S04669.sslabel +++|* CHECK IF *ON* OR *OF* IS SPECIFIED 04670 M01S04670.sslabel +++|* FOR ANY DIRECTIVE OTHER THAN *IB* OR *FC*. 04671 M01S04671.sslabel +++|# 04672 M01S04672.sslabel +++| 04673 M01S04673.sslabel +++| IF (LBARG$OP[0] NQ "IB" AND LBARG$OP[0] NQ "FC") ## 04674 M01S04674.sslabel +++| AND(LBARG$ON[0] NQ 0 OR LBARG$OF[0] NQ 0) 04675 M01S04675.sslabel +++| THEN 04676 M01S04676.sslabel +++| BEGIN 04677 M01S04677.sslabel +++| ERRCODE = S"ON$OF$VIOL"; # "ON,OFF NOT SPECIFIED CORRECTLY" 04678 M01S04678.sslabel +++| # 04679 M01S04679.sslabel +++| LBERR(ERRCODE); 04680 M01S04680.sslabel +++| ERRFLAG = 1; 04681 M01S04681.sslabel +++| RETURN; 04682 M01S04682.sslabel +++| END 04683 M01S04683.sslabel +++| 04684 M01S04684.sslabel +++|# 04685 M01S04685.sslabel +++|* CHECK IF *ON* OR *OF* ARE SPECIFIED 04686 M01S04686.sslabel +++|* CORRECTLY FOR *IB* OR *FC*: 04687 M01S04687.sslabel +++|# 04688 M01S04688.sslabel +++| 04689 M01S04689.sslabel +++| IF (LBARG$OP[0] EQ "IB" OR LBARG$OP[0] EQ "FC") ## 04690 M01S04690.sslabel +++| AND ((LBARG$ON[0] EQ 0 ## 04691 M01S04691.sslabel +++| AND LBARG$OF[0] EQ 0) ## 04692 M01S04692.sslabel +++| OR (LBARG$ON[0] NQ 0 ## 04693 M01S04693.sslabel +++| AND LBARG$OF[0] NQ 0)) 04694 M01S04694.sslabel +++| THEN 04695 M01S04695.sslabel +++| BEGIN 04696 M01S04696.sslabel +++| ERRCODE = S"ON$OF$VIOL"; # "ON,OFF NOT SPECIFIED CORRECTLY" 04697 M01S04697.sslabel +++| # 04698 M01S04698.sslabel +++| LBERR(ERRCODE); 04699 M01S04699.sslabel +++| ERRFLAG = 1; 04700 M01S04700.sslabel +++| RETURN; 04701 M01S04701.sslabel +++| END 04702 M01S04702.sslabel +++| 04703 M01S04703.sslabel +++|# 04704 M01S04704.sslabel +++|* CHECK FOR A LEGAL VALUE FOR *CS*. 04705 M01S04705.sslabel +++|# 04706 M01S04706.sslabel +++| 04707 M01S04707.sslabel +++| IF LBARG$SM[0] GR "H" ## 04708 M01S04708.sslabel +++| OR LBARG$SM[0] LS "A" ## 04709 M01S04709.sslabel +++| OR LBARG$ZSM[0] NQ 0 04710 M01S04710.sslabel +++| THEN 04711 M01S04711.sslabel +++| BEGIN 04712 M01S04712.sslabel +++| ERRCODE = S"ILL$SM"; # "ILLEGAL *SM* NUMBER" # 04713 M01S04713.sslabel +++| LBERR(ERRCODE); 04714 M01S04714.sslabel +++| ERRFLAG = 1; 04715 M01S04715.sslabel +++| RETURN; 04716 M01S04716.sslabel +++| END 04717 M01S04717.sslabel +++| 04718 M01S04718.sslabel +++|# 04719 M01S04719.sslabel +++|* CHECK THE VALUE OF YS AND ZS. 04720 M01S04720.sslabel +++|# 04721 M01S04721.sslabel +++| 04722 M01S04722.sslabel +++| IF LBARG$YI[0] GR MAX$Y ## 04723 M01S04723.sslabel +++| OR LBARG$YF[0] GR MAX$Y ## 04724 M01S04724.sslabel +++| OR LBARG$ZI[0] GR MAX$Z ## 04725 M01S04725.sslabel +++| OR LBARG$ZI[0] EQ Z$NO$CUBE ## 04726 M01S04726.sslabel +++| OR LBARG$ZF[0] GR MAX$Z ## 04727 M01S04727.sslabel +++| OR LBARG$ZF[0] EQ Z$NO$CUBE 04728 M01S04728.sslabel +++| THEN 04729 M01S04729.sslabel +++| BEGIN 04730 M01S04730.sslabel +++| ERRCODE = S"YZ$VIOL"; # "Y,Z OPTION VIOLATED" # 04731 M01S04731.sslabel +++| LBERR(ERRCODE); 04732 M01S04732.sslabel +++| ERRFLAG = 1; 04733 M01S04733.sslabel +++| RETURN; 04734 M01S04734.sslabel +++| END 04735 M01S04735.sslabel +++| 04736 M01S04736.sslabel +++|# 04737 M01S04737.sslabel +++|* CHECK IF *YI*, *ZI*, *YF* AND *ZF* ARE SPECIFIED 04738 M01S04738.sslabel +++|* CORRECTLY. 04739 M01S04739.sslabel +++|# 04740 M01S04740.sslabel +++| 04741 M01S04741.sslabel +++| IF (LBARG$YI[0] EQ -1 ## 04742 M01S04742.sslabel +++| AND LBARG$YF[0] GR 0) ## 04743 M01S04743.sslabel +++| OR (LBARG$ZI[0] EQ -1 ## 04744 M01S04744.sslabel +++| AND LBARG$ZF[0] GR 0) 04745 M01S04745.sslabel +++| THEN 04746 M01S04746.sslabel +++| BEGIN 04747 M01S04747.sslabel +++| ERRCODE = S"YZ$VIOL"; # "Y,Z OPTION VIOLATED" # 04748 M01S04748.sslabel +++| LBERR(ERRCODE); 04749 M01S04749.sslabel +++| ERRFLAG = 1; 04750 M01S04750.sslabel +++| RETURN; 04751 M01S04751.sslabel +++| END 04752 M01S04752.sslabel +++| 04753 M01S04753.sslabel +++|# 04754 M01S04754.sslabel +++|* CHECK IF *N* IS SPECIFIED ALONG WITH 04755 M01S04755.sslabel +++|* *YI* OR *ZI*. 04756 M01S04756.sslabel +++|# 04757 M01S04757.sslabel +++| 04758 M01S04758.sslabel +++| IF (LBARG$YI[0] GQ 0 OR LBARG$ZI[0] GQ 0) AND LBARG$N[0] GR 1 04759 M01S04759.sslabel +++| THEN 04760 M01S04760.sslabel +++| BEGIN 04761 M01S04761.sslabel +++| ERRCODE = S"YZ$VIOL"; # "Y,Z OPTION VIOLATED" # 04762 M01S04762.sslabel +++| LBERR(ERRCODE); 04763 M01S04763.sslabel +++| ERRFLAG = 1; 04764 M01S04764.sslabel +++| RETURN; 04765 M01S04765.sslabel +++| END 04766 M01S04766.sslabel +++| 04767 M01S04767.sslabel +++|# 04768 M01S04768.sslabel +++|* CHECK IF *YF* AND *ZF* ARE NOT 04769 M01S04769.sslabel +++|* SPECIFIED TOGETHER. 04770 M01S04770.sslabel +++|# 04771 M01S04771.sslabel +++| 04772 M01S04772.sslabel +++| IF (LBARG$YF[0] GQ 0 ## 04773 M01S04773.sslabel +++| AND LBARG$ZF[0] EQ -1) ## 04774 M01S04774.sslabel +++| OR (LBARG$YF[0] EQ -1 AND LBARG$ZF[0] GQ 0) 04775 M01S04775.sslabel +++| THEN 04776 M01S04776.sslabel +++| BEGIN 04777 M01S04777.sslabel +++| ERRCODE = S"YZ$VIOL"; # "Y,Z OPTION VIOLATED" # 04778 M01S04778.sslabel +++| LBERR(ERRCODE); 04779 M01S04779.sslabel +++| ERRFLAG = 1; 04780 M01S04780.sslabel +++| RETURN; 04781 M01S04781.sslabel +++| END 04782 M01S04782.sslabel +++| 04783 M01S04783.sslabel +++|# 04784 M01S04784.sslabel +++|* CHECK IF *YF* IS GREATER THAN OR EQUAL 04785 M01S04785.sslabel +++|* TO *YI* WHEN BOTH ARE SPECIFIED. 04786 M01S04786.sslabel +++|# 04787 M01S04787.sslabel +++| 04788 M01S04788.sslabel +++| IF ((LBARG$YI[0] NQ -1) ## 04789 M01S04789.sslabel +++| AND (LBARG$YF[0] NQ -1)) ## 04790 M01S04790.sslabel +++| AND (LBARG$YF[0] LS LBARG$YI[0]) 04791 M01S04791.sslabel +++| THEN 04792 M01S04792.sslabel +++| BEGIN 04793 M01S04793.sslabel +++| ERRCODE = S"YZ$VIOL"; # "Y,Z OPTION VIOLATED" # 04794 M01S04794.sslabel +++| LBERR(ERRCODE); 04795 M01S04795.sslabel +++| ERRFLAG = 1; 04796 M01S04796.sslabel +++| RETURN; 04797 M01S04797.sslabel +++| END 04798 M01S04798.sslabel +++| 04799 M01S04799.sslabel +++|# 04800 M01S04800.sslabel +++|* CHECK IF *ZF* IS GREATER THAN OR EQUAL 04801 M01S04801.sslabel +++|* TO *ZI* WHEN BOTH ARE SPECIFIED. 04802 M01S04802.sslabel +++|# 04803 M01S04803.sslabel +++| 04804 M01S04804.sslabel +++| IF ((LBARG$ZI[0] NQ -1) ## 04805 M01S04805.sslabel +++| AND (LBARG$ZF[0] NQ -1) ) ## 04806 M01S04806.sslabel +++| AND (LBARG$ZF[0] LS LBARG$ZI[0]) 04807 M01S04807.sslabel +++| THEN 04808 M01S04808.sslabel +++| BEGIN 04809 M01S04809.sslabel +++| ERRCODE = S"YZ$VIOL"; # "Y,Z OPTION VIOLATED" # 04810 M01S04810.sslabel +++| LBERR(ERRCODE); 04811 M01S04811.sslabel +++| ERRFLAG = 1; 04812 M01S04812.sslabel +++| RETURN; 04813 M01S04813.sslabel +++| END 04814 M01S04814.sslabel +++| 04815 M01S04815.sslabel +++| 04816 M01S04816.sslabel +++|# 04817 M01S04817.sslabel +++|* CHECK IF *YI* AND *ZI* SPECIFY NON-EXISTANT CUBES WHILE 04818 M01S04818.sslabel +++|* *YF* AND *ZF* ARE NOT SPECIFIED. 04819 M01S04819.sslabel +++|# 04820 M01S04820.sslabel +++| 04821 M01S04821.sslabel +++| IF (LBARG$YF[0] EQ -1 AND LBARG$ZF[0] EQ -1) 04822 M01S04822.sslabel +++| AND LBARG$CC[0] EQ -1 04823 M01S04823.sslabel +++| THEN # SINGLE CUBE SPECIFIED # 04824 M01S04824.sslabel +++| BEGIN 04825 M01S04825.sslabel +++| IF (LBARG$ZI[0] EQ Z$NO$CUBE) ## 04826 M01S04826.sslabel +++| OR ((LBARG$ZI[0] EQ 0) ## 04827 M01S04827.sslabel +++| AND ((LBARG$YI[0] EQ 0) ## 04828 M01S04828.sslabel +++| OR (LBARG$YI[0] EQ 11) ## 04829 M01S04829.sslabel +++| OR (LBARG$YI[0] EQ 12) ## 04830 M01S04830.sslabel +++| OR (LBARG$YI[0] EQ 13) ## 04831 M01S04831.sslabel +++| OR (LBARG$YI[0] EQ 14) ##
| Line S04832 Modification History | |
|---|---|
M01 (Added by) | sslabel |
M02 (Updated by) | msea013 |
Seq # *Modification Id* Act ----------------------------+ 04832 M02S04832.msea013 ---| OR (LBARG$YI[0] EQ 15) ##
| Line S04833 Modification History | |
|---|---|
M01 (Added by) | sslabel |
M02 (Updated by) | msea013 |
Seq # *Modification Id* Act ----------------------------+ 04833 M02S04833.msea013 ---| OR (LBARG$YI[0] EQ 21))) ## 04834 M01S00001.msea013 +++| OR (LBARG$YI[0] EQ 15))) ## 04835 M01S04834.sslabel +++| OR ((LBARG$ZI[0] EQ 1) ## 04836 M01S04835.sslabel +++| AND ((LBARG$YI[0] EQ 11) ## 04837 M01S04836.sslabel +++| OR (LBARG$YI[0] EQ 12) ## 04838 M01S04837.sslabel +++| OR (LBARG$YI[0] EQ 13) ## 04839 M01S04838.sslabel +++| OR (LBARG$YI[0] EQ 14) ##
| Line S04839 Modification History | |
|---|---|
M01 (Added by) | sslabel |
M02 (Updated by) | msea013 |
Seq # *Modification Id* Act ----------------------------+ 04840 M02S04839.msea013 ---| OR (LBARG$YI[0] EQ 15) ##
| Line S04840 Modification History | |
|---|---|
M01 (Added by) | sslabel |
M02 (Updated by) | msea013 |
Seq # *Modification Id* Act ----------------------------+ 04841 M02S04840.msea013 ---| OR (LBARG$YI[0] EQ 0))) ## 04842 M01S00002.msea013 +++| OR (LBARG$YI[0] EQ 15))) ## 04843 M01S04841.sslabel +++| OR ((LBARG$ZI[0] EQ 15) ## 04844 M01S04842.sslabel +++| AND ((LBARG$YI[0] EQ 0) ## 04845 M01S04843.sslabel +++| OR (LBARG$YI[0] EQ 11) ## 04846 M01S04844.sslabel +++| OR (LBARG$YI[0] EQ 21))) ##
| Line S04845 Modification History | |
|---|---|
M01 (Added by) | sslabel |
M02 (Updated by) | msea013 |
Seq # *Modification Id* Act ----------------------------+ 04847 M02S04845.msea013 ---| OR ((LBARG$ZI[0] EQ 14) ##
| Line S04846 Modification History | |
|---|---|
M01 (Added by) | sslabel |
M02 (Updated by) | msea013 |
Seq # *Modification Id* Act ----------------------------+ 04848 M02S04846.msea013 ---| AND ((LBARG$YI[0] EQ 0) ##
| Line S04847 Modification History | |
|---|---|
M01 (Added by) | sslabel |
M02 (Updated by) | msea013 |
Seq # *Modification Id* Act ----------------------------+ 04849 M02S04847.msea013 ---| OR ( LBARG$YI[0] EQ 21))) ## 04850 M01S04848.sslabel +++| THEN # IGNORE NON-EXISTANT CUBE # 04851 M01S04849.sslabel +++| BEGIN 04852 M01S04850.sslabel +++| ERRCODE = S"YZ$VIOL"; # "Y,Z OPTION VIOLATED" # 04853 M01S04851.sslabel +++| LBERR(ERRCODE); 04854 M01S04852.sslabel +++| ERRFLAG =1; 04855 M01S04853.sslabel +++| RETURN; 04856 M01S04854.sslabel +++| END 04857 M01S04855.sslabel +++| 04858 M01S04856.sslabel +++| END 04859 M01S04857.sslabel +++| 04860 M01S04858.sslabel +++| 04861 M01S04859.sslabel +++|# 04862 M01S04860.sslabel +++|* CHECK FOR A LEGAL VALUE FOR *SB*. 04863 M01S04861.sslabel +++|# 04864 M01S04862.sslabel +++| 04865 M01S04863.sslabel +++| IF LBARG$SB[0] LS 0 OR LBARG$SB[0] GR 7 04866 M01S04864.sslabel +++| THEN 04867 M01S04865.sslabel +++| BEGIN 04868 M01S04866.sslabel +++| ERRCODE = S"ILL$SB"; # "ILLEGAL SUBFAMILY" # 04869 M01S04867.sslabel +++| LBERR(ERRCODE); 04870 M01S04868.sslabel +++| ERRFLAG = 1; 04871 M01S04869.sslabel +++| END 04872 M01S04870.sslabel +++| 04873 M01S04871.sslabel +++|# 04874 M01S04872.sslabel +++|* CHECK FOR LEGAL VALUE OF *CC*. 04875 M01S04873.sslabel +++|# 04876 M01S04874.sslabel +++| 04877 M01S04875.sslabel +++| IF (LBARG$CC[0] NQ -1 AND LBARG$OP NQ "AM") OR (LBARG$CC[0] NQ 0 04878 M01S04876.sslabel +++| AND LBARG$CC[0] NQ 15 AND LBARG$CC[0] NQ -1) 04879 M01S04877.sslabel +++| THEN 04880 M01S04878.sslabel +++| BEGIN 04881 M01S04879.sslabel +++| ERRCODE = S"ILL$DIRCTV"; 04882 M01S04880.sslabel +++| LBERR(ERRCODE); 04883 M01S04881.sslabel +++| ERRFLAG = 1; 04884 M01S04882.sslabel +++| RETURN; 04885 M01S04883.sslabel +++| END 04886 M01S04884.sslabel +++| 04887 M01S04885.sslabel +++|# 04888 M01S04886.sslabel +++|* CHECK FOR LEGAL *B* VALUE. 04889 M01S04887.sslabel +++|# 04890 M01S04888.sslabel +++| 04891 M01S04889.sslabel +++| IF (LBARG$B[0] LS 0) OR (LBARG$B[0] GR 1931) ## 04892 M01S04890.sslabel +++| OR ((LBARG$B[0] NQ 600) ## 04893 M01S04891.sslabel +++| AND (LBARG$OP[0] NQ "AM")) 04894 M01S04892.sslabel +++| THEN # *B* INCORRECT # 04895 M01S04893.sslabel +++| BEGIN 04896 M01S04894.sslabel +++| ERRCODE = S"B$INCORR"; 04897 M01S04895.sslabel +++| LBERR(ERRCODE); 04898 M01S04896.sslabel +++| ERRFLAG = 1; 04899 M01S04897.sslabel +++| RETURN; 04900 M01S04898.sslabel +++| END 04901 M01S04899.sslabel +++| 04902 M01S04900.sslabel +++| 04903 M01S04901.sslabel +++| RETURN; # RETURN ERRFLAG = NO ERROR # 04904 M01S04902.sslabel +++| 04905 M01S04903.sslabel +++| END # LBOPT # 04906 M01S04904.sslabel +++| 04907 M01S04905.sslabel +++| TERM 04908 M01S04906.sslabel +++|PROC LBRESP((RESP$CODE),(CALLTYP)); 04909 M01S04907.sslabel +++|# TITLE LBRESP - ACTS UPON RESPONSE CODES FROM EXEC. # 04910 M01S04908.sslabel +++| 04911 M01S04909.sslabel +++| BEGIN # LBRESP # 04912 M01S04910.sslabel +++| 04913 M01S04911.sslabel +++|# 04914 M01S04912.sslabel +++|** LBRESP - ACTS UPON RESPONSE CODES FROM EXEC. 04915 M01S04913.sslabel +++|* 04916 M01S04914.sslabel +++|* THIS PROC CHECKS THE RESPONSE CODE RETURNED BY EXEC 04917 M01S04915.sslabel +++|* AND CALLS *LBERR* WITH THE APPROPRIATE ERROR CODE IF 04918 M01S04916.sslabel +++|* ANY ERROR OCCURRED. 04919 M01S04917.sslabel +++|* 04920 M01S04918.sslabel +++|* PROC LBRESP((RESP$CODE),(CALLTYP)) 04921 M01S04919.sslabel +++|* 04922 M01S04920.sslabel +++|* ENTRY RESP$CODE, CODE RETURNED BY EXEC IN RESPONSE 04923 M01S04921.sslabel +++|* TO A UCP REQUEST, OR BY A CATALOG/MAP 04924 M01S04922.sslabel +++|* ACCESS ROUTINE. 04925 M01S04923.sslabel +++|* CALLTYP, TYPE OF CALL. 04926 M01S04924.sslabel +++|* 0 - CATALOG/MAP ACCESS. 04927 M01S04925.sslabel +++|* 3 - TYPE 3 UCP REQUEST. 04928 M01S04926.sslabel +++|* 4 - TYPE 4 UCP REQUEST. 04929 M01S04927.sslabel +++|* 04930 M01S04928.sslabel +++|* EXIT PROC *LBERR* CALLED OR RETURN DIRECTLY TO CALLING PROC. 04931 M01S04929.sslabel +++|* 04932 M01S04930.sslabel +++|* MESSAGES SSLABEL ABNORMAL, LBRESP. 04933 M01S04931.sslabel +++|* 04934 M01S04932.sslabel +++|* NOTES PROC *LBRESP* CHECKS THE VALUE OF *RESP$CODE* AND CALLS 04935 M01S04933.sslabel +++|* *LBERR* WITH THE APPROPRIATE ERROR CODE IF ANY ERRORS 04936 M01S04934.sslabel +++|* ARE INDICATED. 04937 M01S04935.sslabel +++|# 04938 M01S04936.sslabel +++| 04939 M01S04937.sslabel +++| ITEM RESP$CODE U; # RESPONSE CODE FROM EXEC # 04940 M01S04938.sslabel +++| ITEM CALLTYP U; # TYPE OF CALL MADE # 04941 M01S04939.sslabel +++| 04942 M01S04940.sslabel +++|# 04943 M01S04941.sslabel +++|**** PROC LBRESP - XREF LIST BEGIN. 04944 M01S04942.sslabel +++|# 04945 M01S04943.sslabel +++| 04946 M01S04944.sslabel +++| XREF 04947 M01S04945.sslabel +++| BEGIN 04948 M01S04946.sslabel +++| PROC LBERR; # *SSLABEL* ERROR PROCESSOR # 04949 M01S04947.sslabel +++| PROC MESSAGE; # DISPLAYS MESSAGES # 04950 M01S04948.sslabel +++| PROC RESTPFP; # RESTORE USER-S *PFP* AND ABORT 04951 M01S04949.sslabel +++| OR RETURN # 04952 M01S04950.sslabel +++| END 04953 M01S04951.sslabel +++| 04954 M01S04952.sslabel +++|# 04955 M01S04953.sslabel +++|**** PROC LBRESP - XREF LIST END. 04956 M01S04954.sslabel +++|# 04957 M01S04955.sslabel +++| 04958 M01S04956.sslabel +++| DEF PROCNAME #"LBRESP."#; # PROC NAME # 04959 M01S04957.sslabel +++| 04960 M01S04958.sslabel +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS # 04961 M01S04959.sslabel +++|*CALL COMBFAS 04962 M01S04960.sslabel +++|*CALL COMBCMS 04963 M01S04961.sslabel +++|*CALL COMBCPR 04964 M01S04962.sslabel +++|*CALL COMTERR 04965 M01S04963.sslabel +++|*CALL COMTLAB 04966 M01S04964.sslabel +++| 04967 M01S04965.sslabel +++|# 04968 M01S04966.sslabel +++|* STATUS SWITCH FOR THE RESPONSE CODES 04969 M01S04967.sslabel +++|* RETURNED BY EXEC IN RESPONSE TO TYPE 3 04970 M01S04968.sslabel +++|* CALLSS REQUEST. 04971 M01S04969.sslabel +++|# 04972 M01S04970.sslabel +++| 04973 M01S04971.sslabel +++| SWITCH RESP$ACT3:RESPTYP3 # ACTION ON RESPONSE TO TYPE 3 04974 M01S04972.sslabel +++| REQUEST # 04975 M01S04973.sslabel +++| OK3$ACT:OK3, # REQUEST PROCESSED # 04976 M01S04974.sslabel +++| INTLCK$ACT:C$M$INTLCK, # CATALOG/MAP INTERLOCKED # 04977 M01S04975.sslabel +++| NOPEN$ACT:C$M$NOPEN, # CATALOG/MAP NOT OPEN # 04978 M01S04976.sslabel +++| SUBEX$ACT:SUB$CAT$EX, # SUB CATALOG ALREADY EXISTS # 04979 M01S04977.sslabel +++| NOSUB$ACT:NO$SUB$CAT, # NO SUCH SUBCATALOG # 04980 M01S04978.sslabel +++| PFPROB$ACT: PF$PROB; # PERMANENT FILE PROBLEM # 04981 M01S04979.sslabel +++| 04982 M01S04980.sslabel +++|# 04983 M01S04981.sslabel +++|* STATUS SWITCH FOR THE RESPONSE RETURNED BY 04984 M01S04982.sslabel +++|* EXEC TO A TYPE 4 CALLSS REQUEST. ONLY THE 04985 M01S04983.sslabel +++|* APPLICABLE RESPONSE CODES ARE LISTED HERE. 04986 M01S04984.sslabel +++|# 04987 M01S04985.sslabel +++| 04988 M01S04986.sslabel +++| SWITCH RESP$ACT4:RESPTYP4 # ACTION ON RESPONSE TO TYPE 4 04989 M01S04987.sslabel +++| REQUEST # 04990 M01S04988.sslabel +++| OK4$ACT:OK4, # REQUEST PROCESSED # 04991 M01S04989.sslabel +++| CLBERR$ACT:CART$LB$ERR, # CARTRIDGE LABEL ERROR # 04992 M01S04990.sslabel +++| CUSERR$ACT:CSN$IN$USE, # CARTRIDGE IN USE # 04993 M01S04991.sslabel +++| SMOFF$ACT:SMA$OFF, # STORAGE MODULE OFF # 04994 M01S04992.sslabel +++| CEMERR$ACT:CELL$EMP, 04995 M01S04993.sslabel +++| CFLERR$ACT:CELL$FULL, 04996 M01S04994.sslabel +++| UNKERR$ACT:UNK$CART, # UNKNOWN LABEL ERROR # 04997 M01S04995.sslabel +++| URDERR$ACT:UN$RD$ERR, # UNRECOVERABLE READ ERROR # 04998 M01S04996.sslabel +++| UWTERR$ACT:UN$WRT$ERR, # UNRECOVERABLE WRITE ERROR # 04999 M01S04997.sslabel +++| MHDERR$ACT:M86$HDW$PR; # M86 HARDWARE PROBLEM # 05000 M01S04998.sslabel +++| 05001 M01S04999.sslabel +++| CONTROL EJECT; 05002 M01S05000.sslabel +++| 05003 M01S05001.sslabel +++|# 05004 M01S05002.sslabel +++|* DO PROCESSING APPROPRIATE TO TYPE OF RESPONSE CODE. 05005 M01S05003.sslabel +++|# 05006 M01S05004.sslabel +++| 05007 M01S05005.sslabel +++| IF CALLTYP EQ TYP"TYP3" 05008 M01S05006.sslabel +++| THEN # TYPE 3 UCP REQUEST # 05009 M01S05007.sslabel +++| BEGIN 05010 M01S05008.sslabel +++| GOTO RESP$ACT3[RESP$CODE]; 05011 M01S05009.sslabel +++| END 05012 M01S05010.sslabel +++| 05013 M01S05011.sslabel +++| IF CALLTYP EQ TYP"TYP4" 05014 M01S05012.sslabel +++| THEN # TYPE 4 UCP REQUEST # 05015 M01S05013.sslabel +++| BEGIN 05016 M01S05014.sslabel +++| GOTO RESP$ACT4[RESP$CODE]; 05017 M01S05015.sslabel +++| END 05018 M01S05016.sslabel +++| 05019 M01S05017.sslabel +++| IF CALLTYP NQ 0 05020 M01S05018.sslabel +++| THEN # ILLEGAL CALL TYPE # 05021 M01S05019.sslabel +++| BEGIN 05022 M01S05020.sslabel +++| LBMSG$PROC[0] = PROCNAME; 05023 M01S05021.sslabel +++| MESSAGE(LBMSG[0],SYSUDF1); 05024 M01S05022.sslabel +++| RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT # 05025 M01S05023.sslabel +++| END 05026 M01S05024.sslabel +++| 05027 M01S05025.sslabel +++|# 05028 M01S05026.sslabel +++|* ERROR PROCESSING FOR CATALOG/MAP ACCESS. 05029 M01S05027.sslabel +++|# 05030 M01S05028.sslabel +++| 05031 M01S05029.sslabel +++| IF RESP$CODE EQ CMASTAT"INTLK" 05032 M01S05030.sslabel +++| THEN # CATALOG/MAP INTERLOCKED # 05033 M01S05031.sslabel +++| BEGIN 05034 M01S05032.sslabel +++| ERRCODE = S"CAT$MAP$LK"; 05035 M01S05033.sslabel +++| LBERR(ERRCODE); 05036 M01S05034.sslabel +++| RETURN; 05037 M01S05035.sslabel +++| END 05038 M01S05036.sslabel +++| 05039 M01S05037.sslabel +++| IF RESP$CODE EQ CMASTAT"ATTERR" 05040 M01S05038.sslabel +++| THEN # PROCESS ATTACH ERROR # 05041 M01S05039.sslabel +++| BEGIN 05042 M01S05040.sslabel +++| ERRCODE = S"PF$PROB"; 05043 M01S05041.sslabel +++| LBERR(ERRCODE); 05044 M01S05042.sslabel +++| RETURN; 05045 M01S05043.sslabel +++| END 05046 M01S05044.sslabel +++| 05047 M01S05045.sslabel +++| IF RESP$CODE EQ CMASTAT"NOSUBCAT" 05048 M01S05046.sslabel +++| THEN # NO SUCH SUBCATALOG # 05049 M01S05047.sslabel +++| BEGIN 05050 M01S05048.sslabel +++| ERRCODE = S"NO$CAT$MAP"; 05051 M01S05049.sslabel +++| LBERR(ERRCODE); 05052 M01S05050.sslabel +++| RETURN; 05053 M01S05051.sslabel +++| END 05054 M01S05052.sslabel +++| 05055 M01S05053.sslabel +++| IF RESP$CODE NQ CMASTAT"NOERR" AND RESP$CODE NQ CMASTAT"FOPEN" 05056 M01S05054.sslabel +++| THEN # ERROR OTHER THAN *CATALOG 05057 M01S05055.sslabel +++| ALREADY OPEN* # 05058 M01S05056.sslabel +++| BEGIN 05059 M01S05057.sslabel +++| LBMSG$PROC[0] = PROCNAME; 05060 M01S05058.sslabel +++| MESSAGE(LBMSG[0],SYSUDF1); 05061 M01S05059.sslabel +++| RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT # 05062 M01S05060.sslabel +++| END 05063 M01S05061.sslabel +++| 05064 M01S05062.sslabel +++|# 05065 M01S05063.sslabel +++|* ERROR PROCESSING FOR TYPE 3 REQUESTS TO EXEC. 05066 M01S05064.sslabel +++|# 05067 M01S05065.sslabel +++| 05068 M01S05066.sslabel +++|OK3$ACT: # NO ERROR # 05069 M01S05067.sslabel +++| RETURN; 05070 M01S05068.sslabel +++| 05071 M01S05069.sslabel +++|INTLCK$ACT: # CATALOG/MAP INTERLOCKED # 05072 M01S05070.sslabel +++| ERRCODE = S"CAT$MAP$LK"; 05073 M01S05071.sslabel +++| LBERR(ERRCODE); 05074 M01S05072.sslabel +++| RETURN; 05075 M01S05073.sslabel +++| 05076 M01S05074.sslabel +++|NOPEN$ACT: # CATALOG/MAP NOT OPEN # 05077 M01S05075.sslabel +++| ERRCODE = S"NOT$OPEN"; 05078 M01S05076.sslabel +++| LBERR(ERRCODE); 05079 M01S05077.sslabel +++| RETURN; 05080 M01S05078.sslabel +++| 05081 M01S05079.sslabel +++|SUBEX$ACT: # SUB CATALOG ALREADY EXISTS # 05082 M01S05080.sslabel +++| ERRCODE = S"SM$DEFND"; 05083 M01S05081.sslabel +++| LBERR(ERRCODE); 05084 M01S05082.sslabel +++| RETURN; 05085 M01S05083.sslabel +++| 05086 M01S05084.sslabel +++|NOSUB$ACT: # NO SUCH SUBCATALOG # 05087 M01S05085.sslabel +++| ERRCODE = S"NO$CAT$MAP"; 05088 M01S05086.sslabel +++| LBERR(ERRCODE); 05089 M01S05087.sslabel +++| RETURN; 05090 M01S05088.sslabel +++| 05091 M01S05089.sslabel +++|PFPROB$ACT: # PERMANENT FILE PROBLEM # 05092 M01S05090.sslabel +++| ERRCODE = S"PF$PROB"; 05093 M01S05091.sslabel +++| LBERR(ERRCODE); 05094 M01S05092.sslabel +++| RETURN; 05095 M01S05093.sslabel +++| 05096 M01S05094.sslabel +++|# 05097 M01S05095.sslabel +++|* ERROR PROCESSING FOR TYPE 4 REQUESTS TO EXEC. 05098 M01S05096.sslabel +++|# 05099 M01S05097.sslabel +++| 05100 M01S05098.sslabel +++|OK4$ACT: # NO ERRORS # 05101 M01S05099.sslabel +++| RETURN; 05102 M01S05100.sslabel +++| 05103 M01S05101.sslabel +++|CLBERR$ACT: # CARTRIDGE LABEL ERROR # 05104 M01S05102.sslabel +++| 05105 M01S05103.sslabel +++| ERRCODE = S"LAB$ERR"; 05106 M01S05104.sslabel +++| LBERR(ERRCODE); 05107 M01S05105.sslabel +++| RETURN; 05108 M01S05106.sslabel +++| 05109 M01S05107.sslabel +++| 05110 M01S05108.sslabel +++|CUSERR$ACT: 05111 M01S05109.sslabel +++| 05112 M01S05110.sslabel +++| ERRCODE = S"CAR$IN$USE"; 05113 M01S05111.sslabel +++| LBERR(ERRCODE); 05114 M01S05112.sslabel +++| RETURN; 05115 M01S05113.sslabel +++| 05116 M01S05114.sslabel +++| 05117 M01S05115.sslabel +++|CEMERR$ACT: # CARTRIDGE NOT FOUND # 05118 M01S05116.sslabel +++| 05119 M01S05117.sslabel +++| ERRCODE = S"CR$NOTFND"; 05120 M01S05118.sslabel +++| LBERR(ERRCODE); 05121 M01S05119.sslabel +++| RETURN; 05122 M01S05120.sslabel +++| 05123 M01S05121.sslabel +++|CFLERR$ACT: # CELL IS FULL # 05124 M01S05122.sslabel +++| 05125 M01S05123.sslabel +++| ERRCODE = S"CELL$FULL"; 05126 M01S05124.sslabel +++| LBERR(ERRCODE); 05127 M01S05125.sslabel +++| RETURN; 05128 M01S05126.sslabel +++| 05129 M01S05127.sslabel +++| 05130 M01S05128.sslabel +++|UNKERR$ACT: # UNKNOWN LABEL ERROR # 05131 M01S05129.sslabel +++| 05132 M01S05130.sslabel +++| ERRCODE = S"LAB$ERR"; 05133 M01S05131.sslabel +++| LBERR(ERRCODE); 05134 M01S05132.sslabel +++| RETURN; 05135 M01S05133.sslabel +++| 05136 M01S05134.sslabel +++| 05137 M01S05135.sslabel +++|URDERR$ACT: # UNRECOVERABLE READ ERROR # 05138 M01S05136.sslabel +++| ERRCODE = S"UNRECV$RD"; 05139 M01S05137.sslabel +++| LBERR(ERRCODE); 05140 M01S05138.sslabel +++| RETURN; 05141 M01S05139.sslabel +++| 05142 M01S05140.sslabel +++|UWTERR$ACT: # UNRECOVERABLE WRITE ERROR # 05143 M01S05141.sslabel +++| ERRCODE = S"UNRECV$WRT"; 05144 M01S05142.sslabel +++| LBERR(ERRCODE); 05145 M01S05143.sslabel +++| RETURN; 05146 M01S05144.sslabel +++| 05147 M01S05145.sslabel +++|MHDERR$ACT: # MSF HARDWARE PROBLEM # 05148 M01S05146.sslabel +++| ERRCODE = S"M86$HARDWR"; 05149 M01S05147.sslabel +++| LBERR(ERRCODE); 05150 M01S05148.sslabel +++| RETURN; 05151 M01S05149.sslabel +++|SMOFF$ACT: 05152 M01S05150.sslabel +++| 05153 M01S05151.sslabel +++| ERRCODE = S"SM$OFF"; 05154 M01S05152.sslabel +++| LBERR(ERRCODE); 05155 M01S05153.sslabel +++| RETURN; 05156 M01S05154.sslabel +++| 05157 M01S05155.sslabel +++| 05158 M01S05156.sslabel +++| END # LBRESP # 05159 M01S05157.sslabel +++| 05160 M01S05158.sslabel +++| TERM 05161 M01S05159.sslabel +++|PROC LBRMCSU; 05162 M01S05160.sslabel +++|# TITLE LBRMCSU - REMOVE A *SM* FROM A FAMILY CATALOG. # 05163 M01S05161.sslabel +++| 05164 M01S05162.sslabel +++| BEGIN # LBRMCSU # 05165 M01S05163.sslabel +++| 05166 M01S05164.sslabel +++|# 05167 M01S05165.sslabel +++|** LBRMCSU - REMOVE A *SM* FROM A FAMILY CATALOG. 05168 M01S05166.sslabel +++|* 05169 M01S05167.sslabel +++|* THIS PROC UPDATES THE CATALOG FOR A FAMILY TO REMOVE 05170 M01S05168.sslabel +++|* ASSIGNMENT OF A PARTICULAR CSU. 05171 M01S05169.sslabel +++|* 05172 M01S05170.sslabel +++|* PROC LBRMCSU. 05173 M01S05171.sslabel +++|* 05174 M01S05172.sslabel +++|* ENTRY CRACKED AND SYNTAX CHECKED DIRECTIVE 05175 M01S05173.sslabel +++|* PARAMETERS SET UP IN COMMON AREA DEFINED 05176 M01S05174.sslabel +++|* IN *COMTLBP*. 05177 M01S05175.sslabel +++|* 05178 M01S05176.sslabel +++|* EXIT *SM* REMOVED FROM FAMILY OR ERROR CONDITION. 05179 M01S05177.sslabel +++|* 05180 M01S05178.sslabel +++|* NOTES PROC *LBRMCSU* SEARCHES THE SMMAP FOR THE *SM* 05181 M01S05179.sslabel +++|* SPECIFIED TO VERIFY THAT NO CUBES ARE ASSIGNED 05182 M01S05180.sslabel +++|* TO THE FAMILY. A REQUEST IS THEN SENT TO EXEC 05183 M01S05181.sslabel +++|* TO UPDATE THE CATALOG TO REFLECT THE REMOVAL OF 05184 M01S05182.sslabel +++|* THE *SM*. 05185 M01S05183.sslabel +++|# 05186 M01S05184.sslabel +++| 05187 M01S05185.sslabel +++|# 05188 M01S05186.sslabel +++|**** PROC LBRMCSU - XREF LIST BEGIN. 05189 M01S05187.sslabel +++|# 05190 M01S05188.sslabel +++| 05191 M01S05189.sslabel +++| XREF 05192 M01S05190.sslabel +++| BEGIN 05193 M01S05191.sslabel +++| PROC CALL3; # ISSUES TYPE 3 CALLSS TO EXEC # 05194 M01S05192.sslabel +++| PROC LBERR; # *SSLABEL* ERROR PROCESSOR # 05195 M01S05193.sslabel +++| PROC LBRESP; # PROCESSES RESPONSE FROM EXEC # 05196 M01S05194.sslabel +++| PROC SERCSU; # SEARCHES THE SMMAP # 05197 M01S05195.sslabel +++| END 05198 M01S05196.sslabel +++| 05199 M01S05197.sslabel +++|# 05200 M01S05198.sslabel +++|**** PROC LBRMCSU - XREF LIST END. 05201 M01S05199.sslabel +++|# 05202 M01S05200.sslabel +++| 05203 M01S05201.sslabel +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS # 05204 M01S05202.sslabel +++|*CALL COMBFAS 05205 M01S05203.sslabel +++|*CALL COMBCPR 05206 M01S05204.sslabel +++|*CALL COMTERR 05207 M01S05205.sslabel +++|*CALL COMTLAB 05208 M01S05206.sslabel +++|*CALL COMTLBP 05209 M01S05207.sslabel +++| 05210 M01S05208.sslabel +++| ITEM FLAG I; # ERROR FLAG # 05211 M01S05209.sslabel +++| ITEM REQCODE U; # REQUEST CODE # 05212 M01S05210.sslabel +++| ITEM RESP$CODE U; # RESPONSE CODE FROM EXEC # 05213 M01S05211.sslabel +++| ITEM SERTYPE S:SERCH$TYPE; # SMMAP SEARCH TYPE # 05214 M01S05212.sslabel +++| 05215 M01S05213.sslabel +++| 05216 M01S05214.sslabel +++| ARRAY PK$CSU$ENT [0:0] P(4); # *PICK* SMMAP ENTRY # 05217 M01S05215.sslabel +++| BEGIN 05218 M01S05216.sslabel +++| ITEM PK$MAPENT C(00,00,30); # THREE WORD MAP ENTRY # 05219 M01S05217.sslabel +++| ITEM PK$Y U(03,00,30); # Y COORDINATE # 05220 M01S05218.sslabel +++| ITEM PK$Z U(03,30,30); # Z COORDINATE # 05221 M01S05219.sslabel +++| END 05222 M01S05220.sslabel +++| 05223 M01S05221.sslabel +++| 05224 M01S05222.sslabel +++| CONTROL EJECT; 05225 M01S05223.sslabel +++| 05226 M01S05224.sslabel +++|# 05227 M01S05225.sslabel +++|* SEARCH SMMAP FOR CUBES ASSIGNED TO FAMILY AND UPDATE CATALOG. 05228 M01S05226.sslabel +++|# 05229 M01S05227.sslabel +++| 05230 M01S05228.sslabel +++| SERTYPE = S"ASGN$FAM"; 05231 M01S05229.sslabel +++| SERCSU(SERTYPE,0,0,0,0,LBARG$FM[0],LBARG$SB[0], PK$CSU$ENT[0], 05232 M01S05230.sslabel +++| FLAG); 05233 M01S05231.sslabel +++| 05234 M01S05232.sslabel +++| IF FLAG EQ OK 05235 M01S05233.sslabel +++| THEN # ENTRY FOUND # 05236 M01S05234.sslabel +++| BEGIN 05237 M01S05235.sslabel +++| ERRCODE = S"CB$ASGN$SB"; 05238 M01S05236.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING # 05239 M01S05237.sslabel +++| RETURN; 05240 M01S05238.sslabel +++| END 05241 M01S05239.sslabel +++| 05242 M01S05240.sslabel +++| REQCODE = REQTYP3"RMV$CSU"; 05243 M01S05241.sslabel +++| CALL3(REQCODE,0,0,0,RESP$CODE); # REMOVE *SM* FROM FAMILY # 05244 M01S05242.sslabel +++| IF RESP$CODE NQ RESPTYP3"OK3" 05245 M01S05243.sslabel +++| THEN # PROCESS THE RESPONSE # 05246 M01S05244.sslabel +++| BEGIN 05247 M01S05245.sslabel +++| LBRESP(RESP$CODE,TYP"TYP3"); 05248 M01S05246.sslabel +++| END 05249 M01S05247.sslabel +++| 05250 M01S05248.sslabel +++| RETURN; 05251 M01S05249.sslabel +++| 05252 M01S05250.sslabel +++| END # LBRMCSU # 05253 M01S05251.sslabel +++| 05254 M01S05252.sslabel +++| TERM 05255 M01S05253.sslabel +++|PROC LBRMCUB; 05256 M01S05254.sslabel +++|# TITLE LBRMCUB - REMOVES CUBES FROM FAMILY/POOL/RESERVED AREA. # 05257 M01S05255.sslabel +++| 05258 M01S05256.sslabel +++| BEGIN # LBRMCUB # 05259 M01S05257.sslabel +++| 05260 M01S05258.sslabel +++|# 05261 M01S05259.sslabel +++|** LBRMCUB - REMOVES CUBES FROM FAMILY/POOL/RESERVED AREA. 05262 M01S05260.sslabel +++|* 05263 M01S05261.sslabel +++|* THIS PROC REMOVES ASSIGNED CUBES FROM A FAMILY, POOL, 05264 M01S05262.sslabel +++|* OR RESERVED AREA OF THE CSU. 05265 M01S05263.sslabel +++|* 05266 M01S05264.sslabel +++|* PROC LBRMCUB. 05267 M01S05265.sslabel +++|* 05268 M01S05266.sslabel +++|* ENTRY CRACKED AND SYNTAX CHECKED DIRECTIVE 05269 M01S05267.sslabel +++|* PARAMETERS SET UP IN COMMON AREA DEFINED 05270 M01S05268.sslabel +++|* IN *COMTLBP*. 05271 M01S05269.sslabel +++|* 05272 M01S05270.sslabel +++|* EXIT SPECIFIED NUMBER OR LOCATIONS OF CUBES HAVE 05273 M01S05271.sslabel +++|* BEEN REMOVED, OR ERROR CONDITION. 05274 M01S05272.sslabel +++|* 05275 M01S05273.sslabel +++|* NOTES PROC *LBRMCUB* REMOVES CUBES FROM A FAMILY, 05276 M01S05274.sslabel +++|* POOL, OR RESERVED AREA BY CHANGING THEIR STATUS 05277 M01S05275.sslabel +++|* FROM *ASSIGNED* TO *UNASSIGNED*. IF THE *N* 05278 M01S05276.sslabel +++|* OPTION IS USED THE SMMAP IS SEARCHED FOR EMPTY 05279 M01S05277.sslabel +++|* CUBES WITH THE APPROPRIATE ASSIGNMENT. IF THE 05280 M01S05278.sslabel +++|* LOCATION OPTION IS USED, THE SMMAP IS CHECKED 05281 M01S05279.sslabel +++|* TO ENSURE THAT THE SPECIFIC CUBES ARE EMPTY AND 05282 M01S05280.sslabel +++|* ASSIGNED AS EXPECTED. A REQUEST IS THEN SENT 05283 M01S05281.sslabel +++|* TO EXEC TO REMOVE THE CUBES FROM ASSIGNMENT. 05284 M01S05282.sslabel +++|# 05285 M01S05283.sslabel +++| 05286 M01S05284.sslabel +++|# 05287 M01S05285.sslabel +++|**** PROC LBRMCUB - XREF LIST BEGIN. 05288 M01S05286.sslabel +++|# 05289 M01S05287.sslabel +++| 05290 M01S05288.sslabel +++| XREF 05291 M01S05289.sslabel +++| BEGIN 05292 M01S05290.sslabel +++| PROC CALL3; # ISSUES TYPE 3 CALLSS TO EXEC # 05293 M01S05291.sslabel +++| PROC LBERR; # *SSLABEL* ERROR PROCESSOR # 05294 M01S05292.sslabel +++| PROC LBRESP; # RESPONSE CODE PROCESSOR # 05295 M01S05293.sslabel +++| PROC MFLUSH; # FLUSHES MAP BUFFER # 05296 M01S05294.sslabel +++| PROC SERCSU; # SEARCHES THE SMMAP # 05297 M01S05295.sslabel +++| PROC SETCORD; # SETS UP Y AND Z COORDINATES # 05298 M01S05296.sslabel +++| END 05299 M01S05297.sslabel +++| 05300 M01S05298.sslabel +++|# 05301 M01S05299.sslabel +++|**** PROC LBRMCUB - XREF LIST END. 05302 M01S05300.sslabel +++|# 05303 M01S05301.sslabel +++| 05304 M01S05302.sslabel +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS # 05305 M01S05303.sslabel +++|*CALL COMBFAS 05306 M01S05304.sslabel +++|*CALL COMBCPR 05307 M01S05305.sslabel +++|*CALL COMBMAP 05308 M01S05306.sslabel +++|*CALL COMTERR 05309 M01S05307.sslabel +++|*CALL COMTLAB 05310 M01S05308.sslabel +++|*CALL COMTLBP 05311 M01S05309.sslabel +++| 05312 M01S05310.sslabel +++| ITEM FLAG I; # ERROR FLAG # 05313 M01S05311.sslabel +++| ITEM I I; # LOOP VARIABLE # 05314 M01S05312.sslabel +++| ITEM LOC$OPTION B; # TRUE IF *LOC* OPTION FALSE IF 05315 M01S05313.sslabel +++| *N* OPTION # 05316 M01S05314.sslabel +++| ITEM REQCODE U; # RESPONSE CODE FROM EXEC # 05317 M01S05315.sslabel +++| ITEM RESP$CODE U; # RESPONSE CODE FROM EXEC # 05318 M01S05316.sslabel +++| ITEM SERTYPE S:SERCH$TYPE; # TYPE OF SEARCH THROUGH SMMAP # 05319 M01S05317.sslabel +++| ITEM SP$CODE U; # CODE FOR CUBE/CARTRIDGE 05320 M01S05318.sslabel +++| ASSIGNMENT # 05321 M01S05319.sslabel +++| ITEM SP$FAM C(7); # SPECIFIED FAMILY NAME # 05322 M01S05320.sslabel +++| ITEM SP$SUB U; # SPECIFIED SUB FAMILY # 05323 M01S05321.sslabel +++| ITEM SP$VSN C(8); # SPECIFIED CARTRIDGE *CSND* # 05324 M01S05322.sslabel +++| ITEM SP$Y U; # Y COORDINATE # 05325 M01S05323.sslabel +++| ITEM SP$Z U; # Z COORDINATE # 05326 M01S05324.sslabel +++| 05327 M01S05325.sslabel +++| 05328 M01S05326.sslabel +++| ARRAY PK$CSU$ENT [0:0] P(4); # *PICK* SMMAP ENTRY # 05329 M01S05327.sslabel +++| BEGIN 05330 M01S05328.sslabel +++| ITEM PK$MAPENT C(00,00,30); # THREE WORD MAP ENTRY # 05331 M01S05329.sslabel +++| ITEM PK$Y U(03,00,30); # Y COORDINATE # 05332 M01S05330.sslabel +++| ITEM PK$Z U(03,30,30); # Z COORDINATE # 05333 M01S05331.sslabel +++| END 05334 M01S05332.sslabel +++| 05335 M01S05333.sslabel +++| 05336 M01S05334.sslabel +++| CONTROL EJECT; 05337 M01S05335.sslabel +++| 05338 M01S05336.sslabel +++|# 05339 M01S05337.sslabel +++|* CHECK FOR *N* OPTION OR *LOC* OPTION. 05340 M01S05338.sslabel +++|# 05341 M01S05339.sslabel +++| 05342 M01S05340.sslabel +++| LOC$OPTION = FALSE; 05343 M01S05341.sslabel +++| IF LBARG$YI[0] NQ -1 OR LBARG$ZI[0] NQ -1 05344 M01S05342.sslabel +++| THEN # *LOC* OPTION SPECIFIED # 05345 M01S05343.sslabel +++| BEGIN 05346 M01S05344.sslabel +++| SETCORD; # BUILD Y,Z MATRIX # 05347 M01S05345.sslabel +++| LOC$OPTION = TRUE; 05348 M01S05346.sslabel +++| END 05349 M01S05347.sslabel +++| 05350 M01S05348.sslabel +++|# 05351 M01S05349.sslabel +++|* PROCESS EACH OF THE *N* CUBES SPECIFIED. 05352 M01S05350.sslabel +++|# 05353 M01S05351.sslabel +++| 05354 M01S05352.sslabel +++| SP$VSN = " "; 05355 M01S05353.sslabel +++| SP$FAM = " "; 05356 M01S05354.sslabel +++| SP$SUB = 0; 05357 M01S05355.sslabel +++| FASTFOR I = 1 STEP 1 UNTIL LBARG$N[0] 05358 M01S05356.sslabel +++| DO 05359 M01S05357.sslabel +++| BEGIN # PROCESS *N* CUBES # 05360 M01S05358.sslabel +++| IF NOT LOC$OPTION 05361 M01S05359.sslabel +++| THEN 05362 M01S05360.sslabel +++| BEGIN # *N* OPTION # 05363 M01S05361.sslabel +++| SERTYPE = S"ASSIGN"; # SEARCH FOR ASSIGNED CUBE # 05364 M01S05362.sslabel +++| IF LBARG$PK[0] EQ "F" 05365 M01S05363.sslabel +++| THEN # REMOVE CUBE FROM FAMILY # 05366 M01S05364.sslabel +++| BEGIN 05367 M01S05365.sslabel +++| SP$CODE = CUBSTAT"SUBFAM"; 05368 M01S05366.sslabel +++| SP$FAM = LBARG$FM[0]; 05369 M01S05367.sslabel +++| SP$SUB = LBARG$SB[0]; 05370 M01S05368.sslabel +++| END 05371 M01S05369.sslabel +++| 05372 M01S05370.sslabel +++| IF LBARG$PK[0] EQ "P" 05373 M01S05371.sslabel +++| THEN # REMOVE CUBE FROM POOL # 05374 M01S05372.sslabel +++| BEGIN 05375 M01S05373.sslabel +++| SP$CODE = CUBSTAT"SCRPOOL"; 05376 M01S05374.sslabel +++| END 05377 M01S05375.sslabel +++| 05378 M01S05376.sslabel +++| IF LBARG$PK[0] EQ "R" 05379 M01S05377.sslabel +++| THEN # REMOVE FROM RESERVED AREA # 05380 M01S05378.sslabel +++| BEGIN 05381 M01S05379.sslabel +++| SP$CODE = CUBSTAT"ALTCSU"; 05382 M01S05380.sslabel +++| END 05383 M01S05381.sslabel +++| 05384 M01S05382.sslabel +++| END # *N* OPTION # 05385 M01S05383.sslabel +++| 05386 M01S05384.sslabel +++| ELSE 05387 M01S05385.sslabel +++| BEGIN # *LOC* OPTION # 05388 M01S05386.sslabel +++| SERTYPE = S"LOC"; # LOOK FOR SPECIFIC LOCATION # 05389 M01S05387.sslabel +++| SP$Y = Y$COORD[I]; 05390 M01S05388.sslabel +++| SP$Z = Z$COORD[I]; 05391 M01S05389.sslabel +++| END # *LOC* OPTION # 05392 M01S05390.sslabel +++| 05393 M01S05391.sslabel +++|# 05394 M01S05392.sslabel +++|* SEARCH THE SMMAP FOR THE SPECIFIED ENTRY. 05395 M01S05393.sslabel +++|# 05396 M01S05394.sslabel +++| 05397 M01S05395.sslabel +++| SERCSU(SERTYPE,SP$Y,SP$Z,SP$CODE,SP$VSN,SP$FAM,SP$SUB, 05398 M01S05396.sslabel +++| PK$CSU$ENT[0],FLAG); 05399 M01S05397.sslabel +++| IF FLAG NQ OK 05400 M01S05398.sslabel +++| THEN # NO EMPTY CUBES # 05401 M01S05399.sslabel +++| BEGIN 05402 M01S05400.sslabel +++| NUMDONE = I - 1; 05403 M01S05401.sslabel +++| ERRCODE = S"NO$EMPCB"; 05404 M01S05402.sslabel +++| LBERR(ERRCODE); 05405 M01S05403.sslabel +++| RETURN; 05406 M01S05404.sslabel +++| END 05407 M01S05405.sslabel +++| 05408 M01S05406.sslabel +++|# 05409 M01S05407.sslabel +++|* CHECK CUBE ASSIGNMENT. 05410 M01S05408.sslabel +++|# 05411 M01S05409.sslabel +++| 05412 M01S05410.sslabel +++| P<SMUMAP> = LOC(PK$CSU$ENT[0]); 05413 M01S05411.sslabel +++| IF CM$CSND[0] NQ " " 05414 M01S05412.sslabel +++| THEN # CUBE NOT EMPTY # 05415 M01S05413.sslabel +++| BEGIN 05416 M01S05414.sslabel +++| NUMDONE = I - 1; 05417 M01S05415.sslabel +++| ERRCODE = S"CB$NOT$EMP"; 05418 M01S05416.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING # 05419 M01S05417.sslabel +++| RETURN; 05420 M01S05418.sslabel +++| END 05421 M01S05419.sslabel +++| 05422 M01S05420.sslabel +++| IF LBARG$PK[0] EQ "F" ## 05423 M01S05421.sslabel +++| AND CM$CODE[0] EQ CUBSTAT"SUBFAM" ## 05424 M01S05422.sslabel +++| AND CM$FMLYNM[0] EQ LBARG$FM[0] ## 05425 M01S05423.sslabel +++| AND CM$SUB[0] EQ LBARG$SB[0] 05426 M01S05424.sslabel +++| THEN # REMOVE CUBE FROM FAMILY # 05427 M01S05425.sslabel +++| BEGIN 05428 M01S05426.sslabel +++| REQCODE = REQTYP3"RMV$CUBE"; 05429 M01S05427.sslabel +++| END 05430 M01S05428.sslabel +++| 05431 M01S05429.sslabel +++| ELSE 05432 M01S05430.sslabel +++| BEGIN # REMOVE FROM POOL/RESERVED AREA # 05433 M01S05431.sslabel +++| IF (LBARG$PK[0] EQ "P" AND CM$CODE[0] EQ CUBSTAT"SCRPOOL") 05434 M01S05432.sslabel +++| OR (LBARG$PK[0] EQ "R" AND CM$CODE[0] EQ CUBSTAT"ALTCSU") 05435 M01S00003.msea013 +++| OR (LBARG$PK[0] EQ "R" AND CM$CODE[0] EQ CUBSTAT"SYSUSE") 05436 M01S05433.sslabel +++| THEN 05437 M01S05434.sslabel +++| BEGIN 05438 M01S05435.sslabel +++| REQCODE = REQTYP3"UPD$MAP"; # UPDATE SMMAP ENTRY # 05439 M01S05436.sslabel +++| CM$CODE[0] = CUBSTAT"UNASGN"; 05440 M01S05437.sslabel +++| CM$FLAG1[0] = FALSE; # CLEAR ERROR FLAG IN MAP ENTRY # 05441 M01S05438.sslabel +++| END 05442 M01S05439.sslabel +++| 05443 M01S05440.sslabel +++| ELSE # PROCESS ERROR CONDITION # 05444 M01S05441.sslabel +++| BEGIN 05445 M01S05442.sslabel +++| NUMDONE = I - 1; 05446 M01S05443.sslabel +++| ERRCODE = S"UNX$CB$ASN"; 05447 M01S05444.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING # 05448 M01S05445.sslabel +++| RETURN; 05449 M01S05446.sslabel +++| END 05450 M01S05447.sslabel +++| 05451 M01S05448.sslabel +++| END # REMOVE FROM POOL/RESERVED AREA # 05452 M01S05449.sslabel +++| 05453 M01S05450.sslabel +++|# 05454 M01S05451.sslabel +++|* ISSUE TYPE 3 CALLSS REQUEST AND DO ERROR PROCESSING IF AN 05455 M01S05452.sslabel +++|* ERROR STATUS IS RETURNED BY EXEC. 05456 M01S05453.sslabel +++|# 05457 M01S05454.sslabel +++| 05458 M01S05455.sslabel +++| CALL3(REQCODE,PK$CSU$ENT[0],0,0,RESP$CODE); 05459 M01S05456.sslabel +++| IF RESP$CODE NQ RESPTYP3"OK3" 05460 M01S05457.sslabel +++| THEN # PROCESS THE RESPONSE # 05461 M01S05458.sslabel +++| BEGIN 05462 M01S05459.sslabel +++| LBRESP(RESP$CODE,TYP"TYP3"); 05463 M01S05460.sslabel +++| RETURN; 05464 M01S05461.sslabel +++| END 05465 M01S05462.sslabel +++| 05466 M01S05463.sslabel +++| MFLUSH; 05467 M01S05464.sslabel +++| END # PROCESS *N* CUBES # 05468 M01S05465.sslabel +++| 05469 M01S05466.sslabel +++| RETURN; 05470 M01S05467.sslabel +++| 05471 M01S05468.sslabel +++| END # LBRMCUB # 05472 M01S05469.sslabel +++| 05473 M01S05470.sslabel +++| TERM 05474 M01S05471.sslabel +++|PROC LBRMMSC; 05475 M01S05472.sslabel +++|# TITLE LBRMMSC - REMOVES CARTRIDGES FROM A FAMILY OR POOL. # 05476 M01S05473.sslabel +++| 05477 M01S05474.sslabel +++| BEGIN # LBRMMSC # 05478 M01S05475.sslabel +++| 05479 M01S05476.sslabel +++|# 05480 M01S05477.sslabel +++|** LBRMMSC - REMOVES CARTRIDGES FROM A FAMILY OR POOL. 05481 M01S05478.sslabel +++|* 05482 M01S05479.sslabel +++|* THIS PROC LOCATES AND REMOVES EMPTY CARTRIDGES. 05483 M01S05480.sslabel +++|* 05484 M01S05481.sslabel +++|* PROC LBRMMSC. 05485 M01S05482.sslabel +++|* 05486 M01S05483.sslabel +++|* ENTRY CRACKED AND SYNTAX CHECKED DIRECTIVE 05487 M01S05484.sslabel +++|* PARAMETERS SET UP IN COMMON AREA DEFINED 05488 M01S05485.sslabel +++|* IN *COMTLBP*. 05489 M01S05486.sslabel +++|* (LB$BUFP) = FWA OF A BUFFER 1101B WORDS LONG. 05490 M01S05487.sslabel +++|* 05491 M01S05488.sslabel +++|* EXIT CARTRIDGES REMOVED OR ERROR CONDITION. 05492 M01S05489.sslabel +++|* 05493 M01S05490.sslabel +++|* MESSAGES FAMILY NOT FOUND. 05494 M01S05491.sslabel +++|* CARTRIDGE NOT EMPTY, VSN. 05495 M01S05492.sslabel +++|* 05496 M01S05493.sslabel +++|* NOTES PROC *LBRMMSC* OPENS THE CATALOG AND SEARCHES IT 05497 M01S05494.sslabel +++|* FOR CARTRIDGES FREE IF NO CSN 05498 M01S05495.sslabel +++|* IS SPECIFIED. IF CSN IS SPECIFIED THE SMMAP IS 05499 M01S05496.sslabel +++|* SEARCHED FOR A MATCHING CSN. IF THE *LOST* OPTION 05500 M01S05497.sslabel +++|* IS SPECIFIED, THE CARTRIDGE IS REMOVED FROM THE 05501 M01S05498.sslabel +++|* FAMILY AFTER VERIFYING THAT IT IS MISSING AND 05502 M01S05499.sslabel +++|* ASSIGNED TO THE FAMILY. THE CARTRIDGE IS LOADED 05503 M01S05500.sslabel +++|* AND ITS LABEL IS CHECKED. A NEW SCRATCH LABEL IS 05504 M01S05501.sslabel +++|* WRITTEN AND THE CARTRIDGE IS UNLOADED TO THE POOL 05505 M01S05502.sslabel +++|* OR OUTPUT DRAWER, AS SPECIFIED BY *PT*. 05506 M01S05503.sslabel +++|# 05507 M01S05504.sslabel +++| 05508 M01S05505.sslabel +++|# 05509 M01S05506.sslabel +++|**** PROC LBRMMSC - XREF LIST BEGIN. 05510 M01S05507.sslabel +++|# 05511 M01S05508.sslabel +++| 05512 M01S05509.sslabel +++| XREF 05513 M01S05510.sslabel +++| BEGIN 05514 M01S05511.sslabel +++| PROC CALL3; # ISSUES TYPE 3 EXEC CALLSS # 05515 M01S05512.sslabel +++| PROC CALL4; # ISSUES TYPE 4 EXEC CALLSS # 05516 M01S05513.sslabel +++| PROC CCLOSE; # CLOSE SFMCAT # 05517 M01S05514.sslabel +++| PROC CGETFCT; # GETS AN FCT ENTRY # 05518 M01S05515.sslabel +++| PROC COPEN; # OPENS THE CATALOG # 05519 M01S05516.sslabel +++| PROC DLABFLD; # DISPLAY CARTRIDGE LABEL FIELDS # 05520 M01S05517.sslabel +++| PROC GENLAB; # GENERATES A NEW LABEL # 05521 M01S05518.sslabel +++| PROC LBERR; # *SSLABEL* ERROR PROCESSOR # 05522 M01S05519.sslabel +++| PROC LBRESP; # RESPONSE CODE PROCESSOR # 05523 M01S05520.sslabel +++| PROC LOFPROC; # LIST OF FILES PROCESSOR # 05524 M01S05521.sslabel +++| PROC MCLOSE; # CLOSE SMMAP # 05525 M01S05522.sslabel +++| PROC MESSAGE; # DISPLAYS MESSAGE # 05526 M01S05523.sslabel +++| PROC MFLUSH; # FLUSH MAP BUFFER # 05527 M01S05524.sslabel +++| PROC MOPEN; # OPEN SMMAP # 05528 M01S05525.sslabel +++| PROC RESTPFP; # RESTORE USER-S *PFP* AND ABORT 05529 M01S05526.sslabel +++| OR RETURN # 05530 M01S05527.sslabel +++| PROC SERAST; # SEARCH FOR EMPTY CARTRIDGES # 05531 M01S05528.sslabel +++| PROC SERCSU; # SEARCHES THE SMMAP # 05532 M01S05529.sslabel +++| PROC SETPFP; # SET FAMILY AND USER INDEX # 05533 M01S05530.sslabel +++| FUNC XCOD; # INTEGER TO DISPLAY CONVERSION # 05534 M01S05531.sslabel +++| END 05535 M01S05532.sslabel +++| 05536 M01S05533.sslabel +++|# 05537 M01S05534.sslabel +++|**** PROC LBRMMSC - XREF LIST END. 05538 M01S05535.sslabel +++|# 05539 M01S05536.sslabel +++| 05540 M01S05537.sslabel +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS # 05541 M01S05538.sslabel +++|*CALL COMBFAS 05542 M01S05539.sslabel +++|*CALL COMBCMS 05543 M01S05540.sslabel +++|*CALL,COMBCMD 05544 M01S05541.sslabel +++|*CALL COMBCPR 05545 M01S05542.sslabel +++|*CALL COMBLBL 05546 M01S05543.sslabel +++|*CALL COMBMAP 05547 M01S05544.sslabel +++|*CALL COMBMCT 05548 M01S05545.sslabel +++|*CALL COMBPFP 05549 M01S05546.sslabel +++|*CALL COMSPFM 05550 M01S05547.sslabel +++|*CALL COMTERR 05551 M01S05548.sslabel +++|*CALL COMTLAB 05552 M01S05549.sslabel +++|*CALL COMTLBP 05553 M01S05550.sslabel +++| 05554 M01S05551.sslabel +++| ITEM CART$CSN C(20); # CARTRIDGE SERIAL NUMBER # 05555 M01S05552.sslabel +++| ITEM ERR$CNT I; # ERROR COUNT # 05556 M01S05553.sslabel +++| ITEM FCTORD U; # EMPTY CARTRIDGE FCT ORDINAL # 05557 M01S05554.sslabel +++| ITEM FLAG I; # ERROR FLAG # 05558 M01S05555.sslabel +++| ITEM HR$ERR I; # HARD READ ERRORS # 05559 M01S05556.sslabel +++| ITEM I I; # LOOP VARIABLE # 05560 M01S05557.sslabel +++| ITEM LD$CNT I; # LOAD COUNT # 05561 M01S05558.sslabel +++| ITEM LD$ERR I; # LOAD ERRORS # 05562 M01S05559.sslabel +++| ITEM PS$CNT I; # PASS COUNT # 05563 M01S05560.sslabel +++| ITEM REQCODE I; # REQUEST CODE # 05564 M01S05561.sslabel +++| ITEM RESP$CODE I; # RESPONSE CODE # 05565 M01S05562.sslabel +++| ITEM SERTYPE S:SERCH$TYPE; # SEARCH TYPE # 05566 M01S05563.sslabel +++| ITEM SGROUP I; # SAVE GROUP PARAMETER # 05567 M01S05564.sslabel +++| ITEM SLOT I; # DRAWER NUMBER # 05568 M01S05565.sslabel +++| ITEM SP$CODE I; # SPECIFIED CODE # 05569 M01S05566.sslabel +++| ITEM SP$Y I; # SPECIFIED Y # 05570 M01S05567.sslabel +++| ITEM SP$Z I; # SPECIFIED Z # 05571 M01S05568.sslabel +++| ITEM SR$ERR I; # SOFT READ ERRORS # 05572 M01S05569.sslabel +++| ITEM STR$RD I; # STRIPES READ # 05573 M01S05570.sslabel +++| ITEM STR$WR I; # STRIPES WRITTEN # 05574 M01S05571.sslabel +++| ITEM STR$DM I; # STRIPES DEMARKED # 05575 M01S05572.sslabel +++| ITEM SW$ERR I; # SOFT WRITE ERRORS # 05576 M01S05573.sslabel +++| 05577 M01S05574.sslabel +++| ARRAY CMAP$NM [0:0] P(1); # BUILD SMMAP NAME # 05578 M01S05575.sslabel +++| BEGIN 05579 M01S05576.sslabel +++| ITEM CMAP$NAME C(00,00,07); # SMMAP FILE NAME # 05580 M01S05577.sslabel +++| ITEM CMAP$IN C(00,00,05); # FIRST 5 CHARACTERS # 05581 M01S05578.sslabel +++| ITEM CMAP$ID C(00,30,01); # SM-ID # 05582 M01S05579.sslabel +++| ITEM CMAP$Z C(00,36,24) = [0]; # ZERO FILL # 05583 M01S05580.sslabel +++| END 05584 M01S05581.sslabel +++| 05585 M01S05582.sslabel +++| ARRAY MSFCATNM [0:0] P(1); # CATALOG NAME # 05586 M01S05583.sslabel +++| BEGIN 05587 M01S05584.sslabel +++| ITEM MSFCAT$NM C(00,00,06); # FIRST 6 CHARACTERS # 05588 M01S05585.sslabel +++| ITEM MSFCAT$LST C(00,36,01); # LAST CHARACTER # 05589 M01S05586.sslabel +++| END 05590 M01S05587.sslabel +++| 05591 M01S05588.sslabel +++| ARRAY PK$CSU$ENT [0:0] P(4); # *PICK* SMMAP ENTRY # 05592 M01S05589.sslabel +++| BEGIN 05593 M01S05590.sslabel +++| ITEM PK$MAPENT C(00,00,30); # THREE WORD SMMAP ENTRY # 05594 M01S05591.sslabel +++| ITEM PK$Y U(03,00,30); # Y COORDINATE # 05595 M01S05592.sslabel +++| ITEM PK$Z U(03,30,30); # Z COORDINATE # 05596 M01S05593.sslabel +++| END 05597 M01S05594.sslabel +++| 05598 M01S05595.sslabel +++| 05599 M01S05596.sslabel +++| ARRAY PT$CSU$ENT [0:0] P(5); # *PUT* SMMAP ENTRY # 05600 M01S05597.sslabel +++| BEGIN 05601 M01S05598.sslabel +++| ITEM PT$MAPENT C(00,00,30); # THREE WORD MAP ENTRY # 05602 M01S05599.sslabel +++| ITEM PT$Y U(03,00,30); # Y COORDINATE # 05603 M01S05600.sslabel +++| ITEM PT$Z U(03,30,30); # Z COORDINATE # 05604 M01S05601.sslabel +++| ITEM PT$GR U(04,00,07); # GROUP # 05605 M01S05602.sslabel +++| ITEM PT$GRT U(04,07,04); # GROUP ORDINAL # 05606 M01S05603.sslabel +++| END 05607 M01S05604.sslabel +++| 05608 M01S05605.sslabel +++| 05609 M01S05606.sslabel +++| CONTROL EJECT; 05610 M01S05607.sslabel +++| 05611 M01S05608.sslabel +++|# 05612 M01S05609.sslabel +++|* INITIALIZE POINTERS AND MISCELLANEOUS ITEMS. 05613 M01S05610.sslabel +++|# 05614 M01S05611.sslabel +++| 05615 M01S05612.sslabel +++| PFP$WRD0[0] = 0; 05616 M01S05613.sslabel +++| PFP$FG1[0] = TRUE; 05617 M01S05614.sslabel +++| PFP$FG4[0] = TRUE; 05618 M01S05615.sslabel +++| P<FCT> = LB$BUFP; 05619 M01S05616.sslabel +++| P<SMUMAP> = LOC(PK$CSU$ENT[0]); 05620 M01S05617.sslabel +++| SGROUP = LBARG$GR[0]; 05621 M01S05618.sslabel +++| 05622 M01S05619.sslabel +++|# 05623 M01S05620.sslabel +++|* REMOVE EACH OF *N* CARTRIDGES FROM THE FAMILY OR POOL. 05624 M01S05621.sslabel +++|# 05625 M01S05622.sslabel +++| 05626 M01S05623.sslabel +++| SLOWFOR I = 1 STEP 1 UNTIL LBARG$N[0] 05627 M01S05624.sslabel +++| DO 05628 M01S05625.sslabel +++| BEGIN # REMOVE CARTRIDGE # 05629 M01S05626.sslabel +++| LBARG$GR[0] = SGROUP; 05630 M01S05627.sslabel +++| 05631 M01S05628.sslabel +++|# 05632 M01S05629.sslabel +++|* PROCESSING FOR *CSN NOT SPECIFIED*. 05633 M01S05630.sslabel +++|# 05634 M01S05631.sslabel +++| 05635 M01S05632.sslabel +++| P<SMUMAP> = LOC(PT$CSU$ENT[0]); 05636 M01S05633.sslabel +++| IF LBARG$C[0] EQ 0 05637 M01S05634.sslabel +++| THEN 05638 M01S05635.sslabel +++| BEGIN # CSN NOT SPECIFIED # 05639 M01S05636.sslabel +++| 05640 M01S05637.sslabel +++| IF LBARG$PK[0] EQ "F" 05641 M01S05638.sslabel +++| THEN 05642 M01S05639.sslabel +++| BEGIN # SELECT CARTRIDGE FROM FAMILY # 05643 M01S05640.sslabel +++| 05644 M01S05641.sslabel +++|# 05645 M01S05642.sslabel +++|* OPEN CATALOG AND CHECK ERROR STATUS. 05646 M01S05643.sslabel +++|# 05647 M01S05644.sslabel +++| 05648 M01S05645.sslabel +++| PFP$FAM[0] = LBARG$FM[0]; 05649 M01S05646.sslabel +++| PFP$UI[0] = DEF$UI + LBARG$SB[0]; 05650 M01S05647.sslabel +++| SETPFP(PFP); 05651 M01S05648.sslabel +++| IF PFP$STAT[0] NQ 0 05652 M01S05649.sslabel +++| THEN # FAMILY NOT FOUND # 05653 M01S05650.sslabel +++| BEGIN 05654 M01S05651.sslabel +++| LBMSG$LN[0] = " FAMILY NOT FOUND."; 05655 M01S05652.sslabel +++| MESSAGE(LBMSG[0],SYSUDF1); 05656 M01S05653.sslabel +++| RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT # 05657 M01S05654.sslabel +++| END 05658 M01S05655.sslabel +++| 05659 M01S05656.sslabel +++| MSFCAT$NM[0] = SFMCAT; # SET UP CATALOG NAME # 05660 M01S05657.sslabel +++| MSFCAT$LST[0] = XCOD(LBARG$SB[0]); 05661 M01S05658.sslabel +++| COPEN(LBARG$FM[0],LBARG$SB[0],MSFCATNM[0],"RM",TRUE,FLAG); 05662 M01S05659.sslabel +++| IF FLAG EQ CMASTAT"NOERR" 05663 M01S05660.sslabel +++| THEN 05664 M01S05661.sslabel +++| BEGIN 05665 M01S05662.sslabel +++| LOFPROC(OCT$LFN[1]); # ADD LFN TO LIST OF FILES # 05666 M01S05663.sslabel +++| END 05667 M01S05664.sslabel +++| 05668 M01S05665.sslabel +++| IF FLAG NQ CMASTAT"NOERR" AND FLAG NQ CMASTAT"FOPEN" 05669 M01S05666.sslabel +++| THEN # ERROR CONDITION OTHER THAN 05670 M01S05667.sslabel +++| *CATALOG ALREADY OPEN* # 05671 M01S05668.sslabel +++| BEGIN 05672 M01S05669.sslabel +++| LBRESP(FLAG,0); 05673 M01S05670.sslabel +++| RETURN; 05674 M01S05671.sslabel +++| END 05675 M01S05672.sslabel +++| 05676 M01S05673.sslabel +++| 05677 M01S05674.sslabel +++|# 05678 M01S05675.sslabel +++|* SEARCH *AST* FOR EMPTY CARTRIDGE. 05679 M01S05676.sslabel +++|# 05680 M01S05677.sslabel +++| 05681 M01S05678.sslabel +++| SERAST(FCTORD,FLAG); 05682 M01S05679.sslabel +++| IF FLAG NQ OK 05683 M01S05680.sslabel +++| THEN # NO EMPTY CARTRIDGE FOUND # 05684 M01S05681.sslabel +++| BEGIN 05685 M01S05682.sslabel +++| NUMDONE = I - 1; 05686 M01S05683.sslabel +++| ERRCODE = S"NO$EMP$CR"; 05687 M01S05684.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING # 05688 M01S05685.sslabel +++| RETURN; 05689 M01S05686.sslabel +++| END 05690 M01S05687.sslabel +++| 05691 M01S05688.sslabel +++|# 05692 M01S05689.sslabel +++|* GET FCT ENTRY OF EMPTY CARTRIDGE AND SET LOAD, PASS, 05693 M01S05690.sslabel +++|* AND ERROR COUNTS FOR NEW LABEL. 05694 M01S05691.sslabel +++|# 05695 M01S05692.sslabel +++| 05696 M01S05693.sslabel +++| CGETFCT(LBARG$FM[0],LBARG$SB[0],LBARG$SMID[0],FCTORD, 05697 M01S05694.sslabel +++| LB$BUFP,0,FLAG); 05698 M01S05695.sslabel +++| IF FLAG NQ OK 05699 M01S05696.sslabel +++| THEN # PROCESS ERROR STATUS # 05700 M01S05697.sslabel +++| BEGIN 05701 M01S05698.sslabel +++| LBRESP(FLAG,0); 05702 M01S05699.sslabel +++| RETURN; 05703 M01S05700.sslabel +++| END 05704 M01S05701.sslabel +++| 05705 M01S05702.sslabel +++| LD$CNT = FCT$CRLD[0]; 05706 M01S05703.sslabel +++| HR$ERR = FCT$HRDE[0]; 05707 M01S05704.sslabel +++| SW$ERR = FCT$SWRE[0]; 05708 M01S05705.sslabel +++| SR$ERR = FCT$SRDE[0]; 05709 M01S05706.sslabel +++| STR$RD = FCT$STRD[0]; 05710 M01S05707.sslabel +++| STR$WR = FCT$STWR[0]; 05711 M01S05708.sslabel +++| STR$DM = FCT$STDM[0]; 05712 M01S05709.sslabel +++| 05713 M01S05710.sslabel +++|# 05714 M01S05711.sslabel +++|* GET SMMAP ENTRY. 05715 M01S05712.sslabel +++|# 05716 M01S05713.sslabel +++| 05717 M01S05714.sslabel +++| SERTYPE = S"LOC"; 05718 M01S05715.sslabel +++| SERCSU(SERTYPE,FCT$Y[0],FCT$Z[0],0,0,0,0, PK$CSU$ENT[0], 05719 M01S05716.sslabel +++| FLAG); 05720 M01S05717.sslabel +++| CCLOSE(LBARG$FM[0],LBARG$SB[0],0,FLAG); 05721 M01S05718.sslabel +++| END # SELECT CARTRIDGE FROM FAMILY # 05722 M01S05719.sslabel +++| 05723 M01S05720.sslabel +++| IF LBARG$PK[0] EQ "P" 05724 M01S05721.sslabel +++| THEN 05725 M01S05722.sslabel +++| BEGIN # SELECT CARTRIDGE FROM POOL # 05726 M01S05723.sslabel +++| SERTYPE = S"CART$POOL"; 05727 M01S05724.sslabel +++| SERCSU(SERTYPE,0,0,0,0,0,0,PK$CSU$ENT[0],FLAG); 05728 M01S05725.sslabel +++| IF FLAG NQ OK 05729 M01S05726.sslabel +++| THEN # POOL EMPTY # 05730 M01S05727.sslabel +++| BEGIN 05731 M01S05728.sslabel +++| NUMDONE = I - 1; 05732 M01S05729.sslabel +++| ERRCODE = S"NO$CR$PL"; 05733 M01S05730.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING # 05734 M01S05731.sslabel +++| RETURN; 05735 M01S05732.sslabel +++| END 05736 M01S05733.sslabel +++| 05737 M01S05734.sslabel +++| CMAP$ID[0] = LBARG$SM[0]; 05738 M01S05735.sslabel +++| CMAP$IN[0] = SMMAP; 05739 M01S05736.sslabel +++| END # SELECT CARTRIDGE FROM POOL # 05740 M01S05737.sslabel +++| 05741 M01S05738.sslabel +++| END # VSN NOT SPECIFIED # 05742 M01S05739.sslabel +++| 05743 M01S05740.sslabel +++|# 05744 M01S05741.sslabel +++|* PROCESSING FOR *VSN SPECIFIED*. 05745 M01S05742.sslabel +++|# 05746 M01S05743.sslabel +++| 05747 M01S05744.sslabel +++| IF LBARG$C[0] NQ 0 05748 M01S05745.sslabel +++| THEN 05749 M01S05746.sslabel +++| BEGIN # VSN SPECIFIED # 05750 M01S05747.sslabel +++| SERTYPE = S"CSN$MATCH"; # SEARCH FOR VSN # 05751 M01S05748.sslabel +++| SERCSU(SERTYPE,0,0,0,LBARG$C[0],0,0,PK$CSU$ENT[0],FLAG); 05752 M01S05749.sslabel +++| IF FLAG NQ 0 05753 M01S05750.sslabel +++| THEN # VSN NOT FOUND # 05754 M01S05751.sslabel +++| BEGIN 05755 M01S05752.sslabel +++| ERRCODE = S"CSN$NOTFND"; 05756 M01S05753.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING # 05757 M01S05754.sslabel +++| RETURN; 05758 M01S05755.sslabel +++| END 05759 M01S05756.sslabel +++| 05760 M01S05757.sslabel +++|# 05761 M01S05758.sslabel +++|* OPEN CATALOG AND CHECK ERROR STATUS. 05762 M01S05759.sslabel +++|# 05763 M01S05760.sslabel +++| 05764 M01S05761.sslabel +++| IF CM$CODE[0] EQ CUBSTAT"SUBFAM" 05765 M01S05762.sslabel +++| THEN 05766 M01S05763.sslabel +++| BEGIN # OPEN CATALOG # 05767 M01S05764.sslabel +++| PFP$FAM[0] = CM$FMLYNM[0]; 05768 M01S05765.sslabel +++| PFP$UI[0] = DEF$UI + CM$SUB[0]; 05769 M01S05766.sslabel +++| SETPFP(PFP); 05770 M01S05767.sslabel +++| IF PFP$STAT[0] NQ 0 05771 M01S05768.sslabel +++| THEN # FAMILY NOT FOUND # 05772 M01S05769.sslabel +++| BEGIN 05773 M01S05770.sslabel +++| LBMSG$LN[0] = " FAMILY NOT FOUND."; 05774 M01S05771.sslabel +++| MESSAGE(LBMSG[0],SYSUDF1); 05775 M01S05772.sslabel +++| RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT # 05776 M01S05773.sslabel +++| END 05777 M01S05774.sslabel +++| 05778 M01S05775.sslabel +++| MSFCAT$NM[0] = SFMCAT; # SET UP CATALOG NAME # 05779 M01S05776.sslabel +++| MSFCAT$LST[0] = XCOD(CM$SUB[0]); 05780 M01S05777.sslabel +++| COPEN(CM$FMLYNM[0],CM$SUB[0],MSFCATNM[0],"RM",TRUE,FLAG); 05781 M01S05778.sslabel +++| IF FLAG EQ CMASTAT"NOERR" 05782 M01S05779.sslabel +++| THEN 05783 M01S05780.sslabel +++| BEGIN 05784 M01S05781.sslabel +++| LOFPROC(OCT$LFN[1]); # ADD LFN TO LIST OF FILES # 05785 M01S05782.sslabel +++| END 05786 M01S05783.sslabel +++| 05787 M01S05784.sslabel +++| IF FLAG NQ CMASTAT"NOERR" AND FLAG NQ CMASTAT"FOPEN" 05788 M01S05785.sslabel +++| THEN # ERROR CONDITION OTHER THAN 05789 M01S05786.sslabel +++| *CATALOG ALREADY OPEN* # 05790 M01S05787.sslabel +++| BEGIN 05791 M01S05788.sslabel +++| LBRESP(FLAG,0); 05792 M01S05789.sslabel +++| RETURN; 05793 M01S05790.sslabel +++| END 05794 M01S05791.sslabel +++| 05795 M01S05792.sslabel +++| END # OPEN CATALOG # 05796 M01S05793.sslabel +++| 05797 M01S05794.sslabel +++| END # VSN SPECIFIED # 05798 M01S05795.sslabel +++| 05799 M01S05796.sslabel +++|# 05800 M01S05797.sslabel +++|* *LOST* OPTION PROCESSING. 05801 M01S05798.sslabel +++|# 05802 M01S05799.sslabel +++| 05803 M01S05800.sslabel +++| IF LBARG$LT[0] NQ 0 05804 M01S05801.sslabel +++| THEN 05805 M01S05802.sslabel +++| BEGIN # *LOST* OPTION SPECIFIED # 05806 M01S05803.sslabel +++| IF CM$CODE[0] NQ CUBSTAT"SUBFAM" 05807 M01S05804.sslabel +++| THEN # NOT A FAMILY CARTRIDGE # 05808 M01S05805.sslabel +++| BEGIN 05809 M01S05806.sslabel +++| ERRCODE = S"UNX$CR$ASN"; 05810 M01S05807.sslabel +++| LBERR(ERRCODE); 05811 M01S05808.sslabel +++| RETURN; 05812 M01S05809.sslabel +++| END 05813 M01S05810.sslabel +++| 05814 M01S05811.sslabel +++|# 05815 M01S05812.sslabel +++|* GET FCT ENTRY FOR SPECIFIED CARTRIDGE. 05816 M01S05813.sslabel +++|# 05817 M01S05814.sslabel +++| 05818 M01S05815.sslabel +++| CGETFCT(CM$FMLYNM[0],CM$SUB[0],LBARG$SMID[0],CM$FCTORD[0], 05819 M01S05816.sslabel +++| LB$BUFP,0,FLAG); 05820 M01S05817.sslabel +++| IF FLAG NQ OK 05821 M01S05818.sslabel +++| THEN # PROCESS ERROR STATUS # 05822 M01S05819.sslabel +++| BEGIN 05823 M01S05820.sslabel +++| LBRESP(FLAG,0); 05824 M01S05821.sslabel +++| RETURN; 05825 M01S05822.sslabel +++| END 05826 M01S05823.sslabel +++| 05827 M01S05824.sslabel +++| IF NOT FCT$LCF[0] 05828 M01S05825.sslabel +++| THEN # FCT *LOST* FLAG NOT SET # 05829 M01S05826.sslabel +++| BEGIN 05830 M01S05827.sslabel +++| ERRCODE = S"LOST$NSET"; 05831 M01S05828.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING # 05832 M01S05829.sslabel +++| RETURN; 05833 M01S05830.sslabel +++| END 05834 M01S05831.sslabel +++| 05835 M01S05832.sslabel +++| REQCODE = REQTYP4"LOAD$CART"; 05836 M01S05833.sslabel +++| CALL4(REQCODE,DRD$NUM,CART$CSN,PK$Y[0],PK$Z[0],RESP$CODE); 05837 M01S05834.sslabel +++| IF RESP$CODE EQ RESPTYP4"CELL$EMP" 05838 M01S05835.sslabel +++| THEN 05839 M01S05836.sslabel +++| BEGIN # REMOVE LOST CARTRIDGE FROM FAMILY # 05840 M01S05837.sslabel +++| REQCODE = REQTYP3"RMV$CART"; 05841 M01S05838.sslabel +++| CALL3(REQCODE,PK$CSU$ENT,0,0,RESP$CODE); 05842 M01S05839.sslabel +++| IF RESP$CODE EQ RESPTYP3"MSC$NEMPTY" 05843 M01S05840.sslabel +++| THEN 05844 M01S05841.sslabel +++| BEGIN 05845 M01S05842.sslabel +++| LBMSG$LINE[0] = " CARTRIDGE NOT EMPTY, ."; 05846 M01S05843.sslabel +++| LBMSG$CSN[0] = CM$CSND[0]; 05847 M01S05844.sslabel +++| MESSAGE(LBMSG$BUF[0],SYSUDF1); 05848 M01S05845.sslabel +++| TEST I; 05849 M01S05846.sslabel +++| END 05850 M01S05847.sslabel +++| 05851 M01S05848.sslabel +++| IF RESP$CODE NQ RESPTYP3"OK3" 05852 M01S05849.sslabel +++| THEN 05853 M01S05850.sslabel +++| BEGIN 05854 M01S05851.sslabel +++| LBRESP(RESP$CODE,TYP"TYP3"); 05855 M01S05852.sslabel +++| END 05856 M01S05853.sslabel +++| 05857 M01S05854.sslabel +++| RETURN; 05858 M01S05855.sslabel +++| END # REMOVE LOST CARTRIDGE FROM FAMILY # 05859 M01S05856.sslabel +++| 05860 M01S05857.sslabel +++| ELSE 05861 M01S05858.sslabel +++| BEGIN # PROCESS ERROR STATUS # 05862 M01S05859.sslabel +++| IF RESP$CODE EQ RESPTYP4"OK4" 05863 M01S05860.sslabel +++| THEN 05864 M01S05861.sslabel +++| BEGIN 05865 M01S05862.sslabel +++| REQCODE = REQTYP4"UNLD$CART"; 05866 M01S05863.sslabel +++| CALL4(REQCODE,0,0,PK$Y[0],PK$Z[0],RESP$CODE); 05867 M01S05864.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4" 05868 M01S05865.sslabel +++| THEN 05869 M01S05866.sslabel +++| BEGIN 05870 M01S05867.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4"); 05871 M01S05868.sslabel +++| RETURN; 05872 M01S05869.sslabel +++| END 05873 M01S05870.sslabel +++| 05874 M01S05871.sslabel +++| ERRCODE = S"LOST$SET"; 05875 M01S05872.sslabel +++| LBERR(ERRCODE); 05876 M01S05873.sslabel +++| RETURN; 05877 M01S05874.sslabel +++| END 05878 M01S05875.sslabel +++| 05879 M01S05876.sslabel +++| ELSE # PROCESS DETAIL STATUS # 05880 M01S05877.sslabel +++| BEGIN 05881 M01S05878.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4"); 05882 M01S05879.sslabel +++| RETURN; 05883 M01S05880.sslabel +++| END 05884 M01S05881.sslabel +++| 05885 M01S05882.sslabel +++| END # PROCESS ERROR STATUS # 05886 M01S05883.sslabel +++| 05887 M01S05884.sslabel +++| END # *LOST* OPTION SPECIFIED # 05888 M01S05885.sslabel +++| 05889 M01S05886.sslabel +++|# 05890 M01S05887.sslabel +++|* CHECK CARTRIDGE ASSIGNMENT AND *PT* OPTION. 05891 M01S05888.sslabel +++|# 05892 M01S05889.sslabel +++| 05893 M01S05890.sslabel +++| IF CM$CODE[0] EQ CUBSTAT"SCRPOOL" AND LBARG$PT[0] EQ "P" 05894 M01S05891.sslabel +++| THEN # IGNORE THE CARTRIDGE # 05895 M01S05892.sslabel +++| BEGIN 05896 M01S05893.sslabel +++| TEST I; 05897 M01S05894.sslabel +++| END 05898 M01S05895.sslabel +++| 05899 M01S05896.sslabel +++|# 05900 M01S05897.sslabel +++|* FIND EMPTY OUTPUT DRAWER OR CUBE IN POOL. 05901 M01S05898.sslabel +++|# 05902 M01S05899.sslabel +++| 05903 M01S05900.sslabel +++| IF LBARG$PT[0] EQ "D" 05904 M01S05901.sslabel +++| THEN 05905 M01S05902.sslabel +++| BEGIN # FIND EMPTY OUTPUT DRAWER # 05906 M01S05903.sslabel +++| P<SMUMAP> = LOC(PT$CSU$ENT[0]); 05907 M01S05904.sslabel +++| PT$Y[0] = 12; 05908 M01S05905.sslabel +++| PT$Z[0] = 0; 05909 M01S05906.sslabel +++| CM$FCTORD[0] = 0; 05910 M01S05907.sslabel +++| CM$FMLYNM[0] = ""; 05911 M01S05908.sslabel +++| END # FIND EMPTY OUTPUT DRAWER # 05912 M01S05909.sslabel +++| 05913 M01S05910.sslabel +++| ELSE 05914 M01S05911.sslabel +++| BEGIN # FIND EMPTY CUBE IN POOL # 05915 M01S05912.sslabel +++| SERTYPE = S"ASSIGN"; 05916 M01S05913.sslabel +++| SP$CODE = CUBSTAT"SCRPOOL"; 05917 M01S05914.sslabel +++| SERCSU(SERTYPE,0,0,SP$CODE,"","",0,PT$CSU$ENT[0],FLAG); 05918 M01S05915.sslabel +++| IF FLAG NQ 0 05919 M01S05916.sslabel +++| THEN # NO EMPTY CUBES IN FAMILY/POOL # 05920 M01S05917.sslabel +++| BEGIN 05921 M01S05918.sslabel +++| NUMDONE = I - 1; 05922 M01S05919.sslabel +++| ERRCODE = S"NO$EMPCBFP"; 05923 M01S05920.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING # 05924 M01S05921.sslabel +++| RETURN; 05925 M01S05922.sslabel +++| END 05926 M01S05923.sslabel +++| 05927 M01S05924.sslabel +++| END # FIND EMPTY CUBE IN POOL # 05928 M01S05925.sslabel +++| 05929 M01S05926.sslabel +++|# 05930 M01S05927.sslabel +++|* GET CARTRIDGE AND CHECK ITS LABEL. 05931 M01S05928.sslabel +++|# 05932 M01S05929.sslabel +++| 05933 M01S05930.sslabel +++| REQCODE = REQTYP4"LOAD$CART"; 05934 M01S05931.sslabel +++| CALL4(REQCODE,DRD$NUM,CART$CSN,PK$Y[0],PK$Z[0],RESP$CODE); 05935 M01S05932.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4" ## 05936 M01S05933.sslabel +++| THEN 05937 M01S05934.sslabel +++| BEGIN # LOAD FAILS # 05938 M01S05935.sslabel +++| IF RESP$CODE EQ RESPTYP4"CELL$EMP" 05939 M01S05936.sslabel +++| THEN 05940 M01S05937.sslabel +++| BEGIN # SET UP ERROR FLAGS # 05941 M01S05938.sslabel +++| P<SMUMAP> = LOC(PK$CSU$ENT[0]); 05942 M01S05939.sslabel +++| IF CM$CODE[0] EQ CUBSTAT"SCRPOOL" 05943 M01S05940.sslabel +++| THEN # SET ERROR FLAG IN SMMAP ENTRY # 05944 M01S05941.sslabel +++| BEGIN 05945 M01S05942.sslabel +++| CM$FLAG1[0] = TRUE; 05946 M01S05943.sslabel +++| CALL3(REQTYP3"UPD$MAP",PK$CSU$ENT[0],0,0,FLAG); 05947 M01S05944.sslabel +++| END 05948 M01S05945.sslabel +++| 05949 M01S05946.sslabel +++| ELSE # SET LOST FLAG IN CATALOG ENTRY # 05950 M01S05947.sslabel +++| BEGIN 05951 M01S05948.sslabel +++| CALL3(REQTYP3"UPD$CAT",PK$CSU$ENT[0],UCF"LOST",1,FLAG); 05952 M01S05949.sslabel +++| END 05953 M01S05950.sslabel +++| 05954 M01S05951.sslabel +++| NUMDONE = I - 1; 05955 M01S05952.sslabel +++| ERRCODE = S"CR$NOTFND"; # CARTRIDGE NOT FOUND # 05956 M01S05953.sslabel +++| LBERR(ERRCODE); 05957 M01S05954.sslabel +++| IF FLAG NQ RESPTYP3"OK3" 05958 M01S05955.sslabel +++| THEN 05959 M01S05956.sslabel +++| BEGIN 05960 M01S05957.sslabel +++| LBRESP(FLAG,TYP"TYP3"); 05961 M01S05958.sslabel +++| RETURN; 05962 M01S05959.sslabel +++| END 05963 M01S05960.sslabel +++| 05964 M01S05961.sslabel +++| RETURN; 05965 M01S05962.sslabel +++| END # SET UP ERROR FLAGS # 05966 M01S05963.sslabel +++| 05967 M01S05964.sslabel +++| ELSE # PROCESS RESPONSE CODE # 05968 M01S05965.sslabel +++| BEGIN 05969 M01S05966.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4"); 05970 M01S05967.sslabel +++| IF RESP$CODE EQ RESPTYP4"CART$LB$ERR" ## 05971 M01S05968.sslabel +++| OR RESP$CODE EQ RESPTYP4"UNK$CART" 05972 M01S05969.sslabel +++| THEN # UNLOAD CARTRIDGE TO EXIT TRAY # 05973 M01S05970.sslabel +++| BEGIN 05974 M01S05971.sslabel +++| CALL4(REQTYP4"UNLD$CART",0,0,SM$EXIT$TY,SM$TY$Z, ## 05975 M01S05972.sslabel +++| RESP$CODE); 05976 M01S05973.sslabel +++| END 05977 M01S05974.sslabel +++| 05978 M01S05975.sslabel +++| RETURN; 05979 M01S05976.sslabel +++| END 05980 M01S05977.sslabel +++| 05981 M01S05978.sslabel +++| END # LOAD FAILS # 05982 M01S05979.sslabel +++| 05983 M01S05980.sslabel +++| 05984 M01S05981.sslabel +++| P<SMUMAP> = LOC(PK$CSU$ENT[0]); 05985 M01S05982.sslabel +++| P<LABEL$CART> = OLDLABP; 05986 M01S05983.sslabel +++| 05987 M01S05984.sslabel +++|# 05988 M01S05985.sslabel +++|* VERIFY VSN, Y, Z IN THE LABEL. 05989 M01S05986.sslabel +++|# 05990 M01S05987.sslabel +++| 05991 M01S05988.sslabel +++| IF LAB$CSND[0] NQ CM$CSND[0] ## 05992 M01S05989.sslabel +++| AND(LAB$Y[0] NQ PK$Y[0] OR LAB$Z[0] NQ PK$Z[0]) 05993 M01S05990.sslabel +++| THEN 05994 M01S05991.sslabel +++| BEGIN # TEST Y,Z # 05995 M01S05992.sslabel +++| REQCODE = REQTYP4"UNLD$CART"; 05996 M01S05993.sslabel +++| CALL4(REQCODE,0,0,SM$EXIT$TY,SM$TY$Z,RESP$CODE); 05997 M01S05994.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4" 05998 M01S05995.sslabel +++| THEN 05999 M01S05996.sslabel +++| BEGIN 06000 M01S05997.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4"); 06001 M01S05998.sslabel +++| RETURN; 06002 M01S05999.sslabel +++| END 06003 M01S06000.sslabel +++| 06004 M01S06001.sslabel +++| ERRCODE = S"M86$HARDWR"; # MSF HARDWARE PROBLEM # 06005 M01S06002.sslabel +++| LBERR(ERRCODE); 06006 M01S06003.sslabel +++| RETURN; 06007 M01S06004.sslabel +++| END # TEST Y,Z # 06008 M01S06005.sslabel +++| 06009 M01S06006.sslabel +++| IF CM$CODE[0] EQ CUBSTAT"SCRPOOL" 06010 M01S06007.sslabel +++| THEN # CARTRIDGE FROM POOL # 06011 M01S06008.sslabel +++| BEGIN 06012 M01S06009.sslabel +++| LD$CNT = LAB$CRLD[0]; # USE OLD LOAD/PASS/ERROR COUNTS # 06013 M01S06010.sslabel +++| LD$ERR = LAB$LDER[0]; 06014 M01S06011.sslabel +++| SR$ERR = LAB$SRDE[0]; 06015 M01S06012.sslabel +++| SW$ERR = LAB$SWRE1[0]; 06016 M01S06013.sslabel +++| B<28,4>SW$ERR = LAB$SWRE[0]; 06017 M01S06014.sslabel +++| HR$ERR = LAB$HRDE[0]; 06018 M01S06015.sslabel +++| STR$RD = LAB$STRD[0]; 06019 M01S06016.sslabel +++| STR$WR = LAB$STWR1[0]; 06020 M01S06017.sslabel +++| B<36,24>STR$WR = LAB$STWR[0]; 06021 M01S06018.sslabel +++| STR$DM = LAB$STDM[0]; 06022 M01S06019.sslabel +++| END 06023 M01S06020.sslabel +++| 06024 M01S06021.sslabel +++|# 06025 M01S06022.sslabel +++|* CHECK IF CSU, Y, Z, FAMILY, AND SUBFAMILY DO NOT 06026 M01S06023.sslabel +++|* AGREE IN OLDLABEL AND SMMAP ENTRY. 06027 M01S06024.sslabel +++|# 06028 M01S06025.sslabel +++| 06029 M01S06026.sslabel +++| IF LAB$SMID[0] NQ LBARG$SMID[0] 06030 M01S06027.sslabel +++| OR LAB$Y[0] NQ PK$Y[0] 06031 M01S06028.sslabel +++| OR LAB$Z[0] NQ PK$Z[0] 06032 M01S06029.sslabel +++| OR LAB$FMLY[0] NQ CM$FMLYNM[0] 06033 M01S06030.sslabel +++| OR LAB$SF[0] NQ CM$SUB[0] 06034 M01S06031.sslabel +++| THEN 06035 M01S06032.sslabel +++| BEGIN # SET UP ERROR FLAGS # 06036 M01S06033.sslabel +++| IF CM$CODE[0] EQ CUBSTAT"SCRPOOL" 06037 M01S06034.sslabel +++| THEN # SET ERROR FLAG IN SMMAP ENTRY # 06038 M01S06035.sslabel +++| BEGIN 06039 M01S06036.sslabel +++| CM$FLAG1[0] = TRUE; 06040 M01S06037.sslabel +++| CALL3(REQTYP3"UPD$MAP",PK$CSU$ENT[0],0,0,FLAG); 06041 M01S06038.sslabel +++| END 06042 M01S06039.sslabel +++| 06043 M01S06040.sslabel +++| ELSE # SET LOST FLAG IN CATALOG ENTRY # 06044 M01S06041.sslabel +++| BEGIN 06045 M01S06042.sslabel +++| CALL3(REQTYP3"UPD$CAT",PK$CSU$ENT[0],UCF"LOST",1,FLAG); 06046 M01S06043.sslabel +++| END 06047 M01S06044.sslabel +++| 06048 M01S06045.sslabel +++| IF FLAG NQ RESPTYP3"OK3" 06049 M01S06046.sslabel +++| THEN 06050 M01S06047.sslabel +++| BEGIN 06051 M01S06048.sslabel +++| LBRESP(FLAG,TYP"TYP3"); 06052 M01S06049.sslabel +++| REQCODE = REQTYP4"UNLD$CART"; 06053 M01S06050.sslabel +++| CALL4(REQCODE,0,0,SM$EXIT$TY,SM$TY$Z,RESP$CODE); 06054 M01S06051.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4" 06055 M01S06052.sslabel +++| THEN 06056 M01S06053.sslabel +++| BEGIN 06057 M01S06054.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4"); 06058 M01S06055.sslabel +++| RETURN; 06059 M01S06056.sslabel +++| END 06060 M01S06057.sslabel +++| 06061 M01S06058.sslabel +++| RETURN; 06062 M01S06059.sslabel +++| END 06063 M01S06060.sslabel +++| 06064 M01S06061.sslabel +++| DLABFLD; 06065 M01S06062.sslabel +++| REQCODE = REQTYP4"UNLD$CART"; 06066 M01S06063.sslabel +++| CALL4(REQCODE,0,0,SM$EXIT$TY,SM$TY$Z,RESP$CODE); 06067 M01S06064.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4" 06068 M01S06065.sslabel +++| THEN 06069 M01S06066.sslabel +++| BEGIN 06070 M01S06067.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4"); 06071 M01S06068.sslabel +++| RETURN; 06072 M01S06069.sslabel +++| END 06073 M01S06070.sslabel +++| 06074 M01S06071.sslabel +++| ERRCODE = S"UNXP$CYZFS"; 06075 M01S06072.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING # 06076 M01S06073.sslabel +++| RETURN; 06077 M01S06074.sslabel +++| END # SET UP ERROR FLAGS # 06078 M01S06075.sslabel +++| 06079 M01S06076.sslabel +++|# 06080 M01S06077.sslabel +++|* GENERATE LABEL AND UPDATE SMUMAP. 06081 M01S06078.sslabel +++|# 06082 M01S06079.sslabel +++| 06083 M01S06080.sslabel +++| GENLAB(LABTYPE"SCR$LAB",PT$CSU$ENT[0],LD$CNT,LD$ERR, ## 06084 M01S06081.sslabel +++| SR$ERR,SW$ERR,HR$ERR,STR$RD,STR$WR,STR$DM); 06085 M01S06082.sslabel +++| P<LABEL$CART> = NEWLABP; 06086 M01S06083.sslabel +++| IF B<0,8>LAB$CSN[0] NQ X"C9" ## 06087 M01S06084.sslabel +++| OR B<8,8>LAB$CSN[0] NQ X"C2" OR B<16,8>LAB$CSN[0] NQ X"D4" 06088 M01S06085.sslabel +++| THEN # CARTRIDGE IS NOT IBM # 06089 M01S06086.sslabel +++| BEGIN 06090 M01S06087.sslabel +++| LAB$CCOD[0] = OTHCART; 06091 M01S06088.sslabel +++| END 06092 M01S06089.sslabel +++| 06093 M01S06090.sslabel +++| ELSE 06094 M01S06091.sslabel +++| BEGIN 06095 M01S06092.sslabel +++| LAB$CCOD[0] = IBMCART; 06096 M01S06093.sslabel +++| END 06097 M01S06094.sslabel +++| 06098 M01S06095.sslabel +++| LAB$CRLD[0] = LAB$CRLD[0] + 1; # UPDATE LOAD/PASS COUNTS # 06099 M01S06096.sslabel +++| IF LBARG$PT[0] EQ "D" 06100 M01S06097.sslabel +++| THEN # CLEAR CSU, Y, Z FIELDS # 06101 M01S06098.sslabel +++| BEGIN 06102 M01S06099.sslabel +++| LAB$SMID[0] = 0; 06103 M01S06100.sslabel +++| LAB$Y[0] = 12; # SET TO CAS EXIT # 06104 M01S06101.sslabel +++| LAB$Z[0] = 0; 06105 M01S06102.sslabel +++| END 06106 M01S06103.sslabel +++| 06107 M01S06104.sslabel +++| P<SMUMAP>= LOC(PK$CSU$ENT[0]); 06108 M01S06105.sslabel +++| IF CM$CODE[0] EQ CUBSTAT"SUBFAM" 06109 M01S06106.sslabel +++| THEN # ASSIGNED TO FAMILY # 06110 M01S06107.sslabel +++| BEGIN 06111 M01S06108.sslabel +++| REQCODE = REQTYP3"RMV$CART"; 06112 M01S06109.sslabel +++| END 06113 M01S06110.sslabel +++| 06114 M01S06111.sslabel +++| ELSE # ASSIGNED TO POOL # 06115 M01S06112.sslabel +++| BEGIN 06116 M01S06113.sslabel +++| REQCODE = REQTYP3"UPD$MAP"; 06117 M01S06114.sslabel +++| CM$CSND[0] = " "; # REMOVE VSN FROM SMMAP ENTRY # 06118 M01S06115.sslabel +++| CM$CCOD[0] = " "; 06119 M01S06116.sslabel +++| CM$FLAG1[0] = FALSE; # CLEAR ERROR FLAG IN MAP ENTRY # 06120 M01S06117.sslabel +++| END 06121 M01S06118.sslabel +++| 06122 M01S06119.sslabel +++| CALL3(REQCODE,PK$CSU$ENT[0],0,0,RESP$CODE); 06123 M01S06120.sslabel +++| IF RESP$CODE NQ RESPTYP3"OK3" 06124 M01S06121.sslabel +++| THEN # FAMILY/POOL REMOVAL FAILS # 06125 M01S06122.sslabel +++| BEGIN # PROCESS ERROR RESPONSE # 06126 M01S06123.sslabel +++| IF RESP$CODE NQ RESPTYP3"MSC$NEMPTY" 06127 M01S06124.sslabel +++| THEN 06128 M01S06125.sslabel +++| BEGIN 06129 M01S06126.sslabel +++| LBRESP(RESP$CODE,TYP"TYP3"); 06130 M01S06127.sslabel +++| REQCODE = REQTYP4"UNLD$CART"; 06131 M01S06128.sslabel +++| CALL4(REQCODE,0,0,SM$EXIT$TY,SM$TY$Z,RESP$CODE); 06132 M01S06129.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4" 06133 M01S06130.sslabel +++| THEN 06134 M01S06131.sslabel +++| BEGIN 06135 M01S06132.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4"); 06136 M01S06133.sslabel +++| RETURN; 06137 M01S06134.sslabel +++| END 06138 M01S06135.sslabel +++| 06139 M01S06136.sslabel +++| RETURN; 06140 M01S06137.sslabel +++| END 06141 M01S06138.sslabel +++| 06142 M01S06139.sslabel +++| ELSE 06143 M01S06140.sslabel +++| BEGIN # PROCESS CARTRIDGE NOT EMPTY # 06144 M01S06141.sslabel +++| 06145 M01S06142.sslabel +++| 06146 M01S06143.sslabel +++|# 06147 M01S06144.sslabel +++|* UNLOAD CARTRIDGE BACK AT ORIGINAL LOCATION. 06148 M01S06145.sslabel +++|# 06149 M01S06146.sslabel +++| 06150 M01S06147.sslabel +++| CALL4(REQTYP4"UNLD$CART",DRD$NUM,CART$CSN,PK$Y[0], ## 06151 M01S06148.sslabel +++| PK$Z[0],RESP$CODE); 06152 M01S06149.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4" 06153 M01S06150.sslabel +++| THEN 06154 M01S06151.sslabel +++| BEGIN 06155 M01S06152.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4"); 06156 M01S06153.sslabel +++| RETURN; 06157 M01S06154.sslabel +++| END 06158 M01S06155.sslabel +++| 06159 M01S06156.sslabel +++| ERRCODE = S"CR$NTEMPT"; 06160 M01S06157.sslabel +++| LBERR(ERRCODE); 06161 M01S06158.sslabel +++| END # PROCESS CARTRIDGE NOT EMPTY # 06162 M01S06159.sslabel +++| 06163 M01S06160.sslabel +++| END # PROCESS ERROR RESPONSE # 06164 M01S06161.sslabel +++| 06165 M01S06162.sslabel +++|# 06166 M01S06163.sslabel +++|* WRITE NEW LABEL AND PUT CARTRIDGE IN NEW LOCATION. 06167 M01S06164.sslabel +++|# 06168 M01S06165.sslabel +++| 06169 M01S06166.sslabel +++| REQCODE = REQTYP4"WRT$LAB"; 06170 M01S06167.sslabel +++| CALL4(REQCODE,DRD$NUM,CART$CSN,PT$Y,PT$Z,RESP$CODE); 06171 M01S06168.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4" 06172 M01S06169.sslabel +++| THEN # *WRITE* FAILS # 06173 M01S06170.sslabel +++| BEGIN 06174 M01S06171.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4"); 06175 M01S06172.sslabel +++| RETURN; 06176 M01S06173.sslabel +++| END 06177 M01S06174.sslabel +++| 06178 M01S06175.sslabel +++| IF LBARG$PT[0] EQ "P" 06179 M01S06176.sslabel +++| THEN 06180 M01S06177.sslabel +++| BEGIN # ADD CARTRIDGE TO POOL # 06181 M01S06178.sslabel +++| REQCODE = REQTYP3"UPD$MAP"; 06182 M01S06179.sslabel +++| P<SMUMAP> = LOC(PT$CSU$ENT[0]); 06183 M01S06180.sslabel +++| CM$CSND[0] = LAB$CSND[0]; 06184 M01S06181.sslabel +++| CM$CCOD[0] = LAB$CCOD[0]; 06185 M01S06182.sslabel +++| 06186 M01S06183.sslabel +++|# 06187 M01S06184.sslabel +++|* ADD CARTRIDGE TO POOL. 06188 M01S06185.sslabel +++|# 06189 M01S06186.sslabel +++| 06190 M01S06187.sslabel +++| CALL3(REQCODE,PT$CSU$ENT[0],0,0,RESP$CODE); 06191 M01S06188.sslabel +++| IF RESP$CODE NQ RESPTYP3"OK3" 06192 M01S06189.sslabel +++| THEN # MAP UPDATE FAILS # 06193 M01S06190.sslabel +++| BEGIN 06194 M01S06191.sslabel +++| LBRESP(RESP$CODE,TYP"TYP3"); 06195 M01S06192.sslabel +++| RETURN; 06196 M01S06193.sslabel +++| END 06197 M01S06194.sslabel +++| 06198 M01S06195.sslabel +++| END # ADD CARTRIDGE TO POOL # 06199 M01S06196.sslabel +++| 06200 M01S06197.sslabel +++| MFLUSH; # FLUSH MAP BUFFER # 06201 M01S06198.sslabel +++| END 06202 M01S06199.sslabel +++| 06203 M01S06200.sslabel +++| 06204 M01S06201.sslabel +++| RETURN; 06205 M01S06202.sslabel +++| 06206 M01S06203.sslabel +++| END # LBRMMSC # 06207 M01S06204.sslabel +++| 06208 M01S06205.sslabel +++| TERM 06209 M01S06206.sslabel +++|PROC LBRSMSC; 06210 M01S06207.sslabel +++|# TITLE LBRSMSC - RESTORES A CARTRIDGE TO THE CSU. # 06211 M01S06208.sslabel +++| 06212 M01S06209.sslabel +++| BEGIN # LBRSMSC # 06213 M01S06210.sslabel +++| 06214 M01S06211.sslabel +++|# 06215 M01S06212.sslabel +++|** LBRSMSC - RESTORES A CARTRIDGE TO THE CSU. 06216 M01S06213.sslabel +++|* 06217 M01S06214.sslabel +++|* THIS PROC GETS A CARTRIDGE FROM THE INPUT DRAWER AND RETURNS 06218 M01S06215.sslabel +++|* IT TO ITS ASSIGNED LOCATION. 06219 M01S06216.sslabel +++|* 06220 M01S06217.sslabel +++|* PROC LBRSMSC. 06221 M01S06218.sslabel +++|* 06222 M01S06219.sslabel +++|* ENTRY CRACKED AND SYNTAX CHECKED DIRECTIVE 06223 M01S06220.sslabel +++|* PARAMETERS SET UP IN COMMON AREA DEFINED 06224 M01S06221.sslabel +++|* IN *COMTLBP*. 06225 M01S06222.sslabel +++|* 06226 M01S06223.sslabel +++|* EXIT CARTRIDGE RESTORED OR ERROR CONDITION. 06227 M01S06224.sslabel +++|* 06228 M01S06225.sslabel +++|* NOTES PROC *LBRSMSC* CHECKS THAT THERE IS A CARTRIDGE IN 06229 M01S06226.sslabel +++|* AN INPUT DRAWER AS SPECIFIED, AND CALLS EXEC TO 06230 M01S06227.sslabel +++|* BRING THE CARTRIDGE TO A DRIVE AND READ ITS LABEL. 06231 M01S06228.sslabel +++|* IF THE LABEL HAS THE CORRECT *SM* NUMBER, AND IF 06232 M01S06229.sslabel +++|* A SMMAP ENTRY IS FOUND WITH MATCHING VSN, FAMILY, 06233 M01S06230.sslabel +++|* SUBFAMILY, AND COORDINATES, THEN EXEC IS CALLED TO 06234 M01S06231.sslabel +++|* REPLACE THE CARTRIDGE AND UPDATE THE CATALOG. 06235 M01S06232.sslabel +++|# 06236 M01S06233.sslabel +++| 06237 M01S06234.sslabel +++|# 06238 M01S06235.sslabel +++|**** PROC LBRSMSC - XREF LIST BEGIN. 06239 M01S06236.sslabel +++|# 06240 M01S06237.sslabel +++| 06241 M01S06238.sslabel +++| XREF 06242 M01S06239.sslabel +++| BEGIN 06243 M01S06240.sslabel +++| PROC CALL3; # ISSUES TYPE 3 CALLSS TO EXEC # 06244 M01S06241.sslabel +++| PROC CALL4; # ISSUES TYPE 4 CALLSS TO EXEC # 06245 M01S06242.sslabel +++| PROC DLABFLD; # DISPLAY CARTRIDGE LABEL FIELDS # 06246 M01S06243.sslabel +++| PROC LBERR; # *SSLABEL* ERROR PROCESSOR # 06247 M01S06244.sslabel +++| PROC LBRESP; # RESPONSE CODE PROCESSOR # 06248 M01S06245.sslabel +++| PROC SERCSU; # SEARCHES SMMAP # 06249 M01S06246.sslabel +++| END 06250 M01S06247.sslabel +++| 06251 M01S06248.sslabel +++|# 06252 M01S06249.sslabel +++|**** PROC LBRSMSC - XREF LIST END. 06253 M01S06250.sslabel +++|# 06254 M01S06251.sslabel +++| 06255 M01S06252.sslabel +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS # 06256 M01S06253.sslabel +++|*CALL COMBFAS 06257 M01S06254.sslabel +++|*CALL COMBCPR 06258 M01S06255.sslabel +++|*CALL COMBLBL 06259 M01S06256.sslabel +++|*CALL COMBMAP 06260 M01S06257.sslabel +++|*CALL COMTERR 06261 M01S06258.sslabel +++|*CALL COMTLAB 06262 M01S06259.sslabel +++|*CALL COMTLBP 06263 M01S06260.sslabel +++| ITEM CART$CSN C(20); # CARTRIDGE SERIAL NUMBER # 06264 M01S06261.sslabel +++| ITEM CATFLD U; # CATALOG FIELD # 06265 M01S06262.sslabel +++| ITEM CATVALUE I; # CATALOG VALUE # 06266 M01S06263.sslabel +++| ITEM FLAG I; # ERROR FLAG # 06267 M01S06264.sslabel +++| ITEM I I; # INDUCTION VARIABLE # 06268 M01S06265.sslabel +++| ITEM REQCODE I; # REQUEST CODE # 06269 M01S06266.sslabel +++| ITEM RESP$CODE I; # RESPONSE CODE # 06270 M01S06267.sslabel +++| ITEM SERTYPE S:SERCH$TYPE; # SEARCH TYPE # 06271 M01S06268.sslabel +++| ITEM SLOT I; # DRAWER NUMBER # 06272 M01S06269.sslabel +++| ITEM SP$VSN C(8); # SPECIFIED *CSN* # 06273 M01S06270.sslabel +++| ITEM SP$Y I; # SPECIFIED Y # 06274 M01S06271.sslabel +++| ITEM SP$Z I; # SPECIFIED Z # 06275 M01S06272.sslabel +++| 06276 M01S06273.sslabel +++| 06277 M01S06274.sslabel +++| ARRAY PT$CSU$ENT [0:0] P(5); # *PUT* SMMAP ENTRY # 06278 M01S06275.sslabel +++| BEGIN 06279 M01S06276.sslabel +++| ITEM PT$MAPENT C(00,00,30); # THREE WORD MAP ENTRY # 06280 M01S06277.sslabel +++| ITEM PT$Y U(03,00,30); # Y COORDINATE # 06281 M01S06278.sslabel +++| ITEM PT$Z U(03,30,30); # Z COORDINATE # 06282 M01S06279.sslabel +++| ITEM PT$GR U(04,00,07); # GROUP # 06283 M01S06280.sslabel +++| ITEM PT$GRT U(04,07,04); # GROUP ORDINAL # 06284 M01S06281.sslabel +++| END 06285 M01S06282.sslabel +++| 06286 M01S06283.sslabel +++| BASED 06287 M01S06284.sslabel +++| ARRAY TEMP$LAB [0:0] P(1); 06288 M01S06285.sslabel +++| BEGIN 06289 M01S06286.sslabel +++| ITEM TEMP$LABW U(00,00,60); 06290 M01S06287.sslabel +++| END 06291 M01S06288.sslabel +++| 06292 M01S06289.sslabel +++| 06293 M01S06290.sslabel +++| CONTROL EJECT; 06294 M01S06291.sslabel +++| 06295 M01S06292.sslabel +++|# 06296 M01S06293.sslabel +++|* FIND CARTRIDGE IN SPECIFIED INPUT DRAWER AND LOAD IT. 06297 M01S06294.sslabel +++|# 06298 M01S06295.sslabel +++| 06299 M01S06296.sslabel +++| REQCODE = REQTYP4"LOAD$CART"; 06300 M01S06297.sslabel +++| PT$Y[0] = 14; 06301 M01S06298.sslabel +++| PT$Z[0] = 0; 06302 M01S06299.sslabel +++| CALL4(REQCODE,DRD$NUM,CART$CSN,PT$Y[0],PT$Z[0],RESP$CODE); 06303 M01S06300.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4" ## 06304 M01S06301.sslabel +++| THEN # LOAD FAILS # 06305 M01S06302.sslabel +++| BEGIN 06306 M01S06303.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4"); 06307 M01S06304.sslabel +++| RETURN; 06308 M01S06305.sslabel +++| END 06309 M01S06306.sslabel +++| 06310 M01S06307.sslabel +++| DRD$NUM = CPR$DRD[0]; # SET UP TRANSPORT ID # 06311 M01S06308.sslabel +++| 06312 M01S06309.sslabel +++| P<LABEL$CART> = OLDLABP; 06313 M01S06310.sslabel +++| 06314 M01S06311.sslabel +++|# 06315 M01S06312.sslabel +++|* COMPARE THE CSU-ID, FAMILY AND THE SUBFAMILY IN THE LABEL 06316 M01S06313.sslabel +++|* AGAINST THE USER SPECIFIED VALUES. 06317 M01S06314.sslabel +++|# 06318 M01S06315.sslabel +++| 06319 M01S06316.sslabel +++| IF LAB$SMID[0] NQ LBARG$SM[0] 06320 M01S06317.sslabel +++| THEN 06321 M01S06318.sslabel +++| BEGIN 06322 M01S06319.sslabel +++| DLABFLD; # DISPLAY LABEL FIELDS # 06323 M01S06320.sslabel +++| REQCODE = REQTYP4"UNLD$CART"; 06324 M01S06321.sslabel +++| CALL4(REQCODE,0,0,SM$EXIT$TY,SM$TY$Z,RESP$CODE); 06325 M01S06322.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4" 06326 M01S06323.sslabel +++| THEN 06327 M01S06324.sslabel +++| BEGIN 06328 M01S06325.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4"); 06329 M01S06326.sslabel +++| RETURN; 06330 M01S06327.sslabel +++| END 06331 M01S06328.sslabel +++| 06332 M01S06329.sslabel +++| ERRCODE = S"UNXP$CYZFS"; 06333 M01S06330.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING # 06334 M01S06331.sslabel +++| RETURN; 06335 M01S06332.sslabel +++| END 06336 M01S06333.sslabel +++| 06337 M01S06334.sslabel +++| SERTYPE = S"CSN$MATCH"; 06338 M01S06335.sslabel +++| SP$VSN = LAB$CSND[0]; # SEARCH SMMAP FOR VSN MATCH # 06339 M01S06336.sslabel +++| SERCSU(SERTYPE,0,0,0,SP$VSN,0,0,PT$CSU$ENT[0],FLAG); 06340 M01S06337.sslabel +++| IF FLAG NQ OK 06341 M01S06338.sslabel +++| THEN # VSN NOT FOUND # 06342 M01S06339.sslabel +++| BEGIN 06343 M01S06340.sslabel +++| DLABFLD; # DISPLAY LABEL FIELDS # 06344 M01S06341.sslabel +++| REQCODE = REQTYP4"UNLD$CART"; 06345 M01S06342.sslabel +++| CALL4(REQCODE,0,0,SM$EXIT$TY,SM$TY$Z,RESP$CODE); 06346 M01S06343.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4" 06347 M01S06344.sslabel +++| THEN 06348 M01S06345.sslabel +++| BEGIN 06349 M01S06346.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4"); 06350 M01S06347.sslabel +++| RETURN; 06351 M01S06348.sslabel +++| END 06352 M01S06349.sslabel +++| 06353 M01S06350.sslabel +++| ERRCODE = S"CSN$NOTFND"; 06354 M01S06351.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING # 06355 M01S06352.sslabel +++| RETURN; 06356 M01S06353.sslabel +++| END 06357 M01S06354.sslabel +++| 06358 M01S06355.sslabel +++| P<SMUMAP> = LOC(PT$CSU$ENT[0]); 06359 M01S06356.sslabel +++| 06360 M01S06357.sslabel +++|# 06361 M01S06358.sslabel +++|* CHECK TO SEE IF LABEL AND MAP ENTRY DIFFER ON 06362 M01S06359.sslabel +++|* Y, Z, FAMILY, OR SUBFAMILY. 06363 M01S06360.sslabel +++|# 06364 M01S06361.sslabel +++| 06365 M01S06362.sslabel +++| IF LAB$Y[0] NQ PT$Y[0] ## 06366 M01S06363.sslabel +++| OR LAB$Z[0] NQ PT$Z[0] ## 06367 M01S06364.sslabel +++| OR LAB$FMLY[0] NQ CM$FMLYNM[0] ## 06368 M01S06365.sslabel +++| OR LAB$SF[0] NQ CM$SUB[0] 06369 M01S06366.sslabel +++| THEN 06370 M01S06367.sslabel +++| BEGIN 06371 M01S06368.sslabel +++| REQCODE = REQTYP4"UNLD$CART"; 06372 M01S06369.sslabel +++| CALL4(REQCODE,0,0,SM$EXIT$TY,SM$TY$Z,RESP$CODE); 06373 M01S06370.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4" 06374 M01S06371.sslabel +++| THEN 06375 M01S06372.sslabel +++| BEGIN 06376 M01S06373.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4"); 06377 M01S06374.sslabel +++| RETURN; 06378 M01S06375.sslabel +++| END 06379 M01S06376.sslabel +++| 06380 M01S06377.sslabel +++| DLABFLD; # DISPLAY LABEL FIELDS # 06381 M01S06378.sslabel +++| ERRCODE = S"UNXP$CYZFS"; 06382 M01S06379.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING # 06383 M01S06380.sslabel +++| RETURN; 06384 M01S06381.sslabel +++| END 06385 M01S06382.sslabel +++| 06386 M01S06383.sslabel +++|# 06387 M01S06384.sslabel +++|* CLEAR *LOST* FLAG IN THE CATALOG IF THE CARTRIDGE IS TO BE 06388 M01S06385.sslabel +++|* RESTORED TO THE FAMILY OR CLEAR SMMAP ERROR FLAG IF THE 06389 M01S06386.sslabel +++|* CARTRIDGE IS TO BE RESTORED TO THE POOL AND RETURN THE 06390 M01S06387.sslabel +++|* CARTRIDGE TO ITS ASSIGNED LOCATION. 06391 M01S06388.sslabel +++|# 06392 M01S06389.sslabel +++| 06393 M01S06390.sslabel +++| 06394 M01S06391.sslabel +++| IF CM$CODE[0] EQ CUBSTAT"SUBFAM" 06395 M01S06392.sslabel +++| THEN 06396 M01S06393.sslabel +++| BEGIN # CLEAR *LOST* FLAG # 06397 M01S06394.sslabel +++| REQCODE = REQTYP3"UPD$CAT"; 06398 M01S06395.sslabel +++| CATFLD = UCF"LOST"; 06399 M01S06396.sslabel +++| CATVALUE = 0; # CLEAR *LOST* FLAG IN CATALOG # 06400 M01S06397.sslabel +++| CALL3(REQCODE,PT$CSU$ENT[0],CATFLD,CATVALUE,RESP$CODE); 06401 M01S06398.sslabel +++| END # CLEAR *LOST* FLAG # 06402 M01S06399.sslabel +++| 06403 M01S06400.sslabel +++| ELSE 06404 M01S06401.sslabel +++| BEGIN # CLEAR SMMAP ERROR FLAG # 06405 M01S06402.sslabel +++| P<SMUMAP> = LOC(PT$CSU$ENT[0]); 06406 M01S06403.sslabel +++| CM$FLAG1[0] = FALSE; 06407 M01S06404.sslabel +++| REQCODE = REQTYP3"UPD$MAP"; 06408 M01S06405.sslabel +++| CALL3(REQCODE,PT$CSU$ENT[0],0,0,FLAG); 06409 M01S06406.sslabel +++| END # CLEAR SMMAP ERROR FLAG # 06410 M01S06407.sslabel +++| 06411 M01S06408.sslabel +++| IF RESP$CODE NQ RESPTYP3"OK3" 06412 M01S06409.sslabel +++| THEN # UPDATE CATALOG/MAP FAILED # 06413 M01S06410.sslabel +++| BEGIN 06414 M01S06411.sslabel +++| REQCODE = REQTYP4"UNLD$CART"; 06415 M01S06412.sslabel +++| CALL4(REQCODE,0,0,SM$EXIT$TY,SM$TY$Z,RESP$CODE); 06416 M01S06413.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4" 06417 M01S06414.sslabel +++| THEN 06418 M01S06415.sslabel +++| BEGIN 06419 M01S06416.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4"); 06420 M01S06417.sslabel +++| RETURN; 06421 M01S06418.sslabel +++| END 06422 M01S06419.sslabel +++| 06423 M01S06420.sslabel +++| DLABFLD; # DISPLAY LABEL FIELDS # 06424 M01S06421.sslabel +++| LBRESP(RESP$CODE,TYP"TYP3"); 06425 M01S06422.sslabel +++| RETURN; 06426 M01S06423.sslabel +++| END 06427 M01S06424.sslabel +++| 06428 M01S06425.sslabel +++|# 06429 M01S06426.sslabel +++|* PUT CARTRIDGE IN ASSIGNED LOCATION. 06430 M01S06427.sslabel +++|# 06431 M01S06428.sslabel +++| 06432 M01S06429.sslabel +++| P<LABEL$CART> = OLDLABP; 06433 M01S06430.sslabel +++| P<TEMP$LAB> = NEWLABP; 06434 M01S06431.sslabel +++| SLOWFOR I = 0 STEP 1 UNTIL LABLEN-1 06435 M01S06432.sslabel +++| DO # MOVE LABEL TO NEW BUFFER # 06436 M01S06433.sslabel +++| BEGIN 06437 M01S06434.sslabel +++| TEMP$LABW[I] = LAB$W1[I]; 06438 M01S06435.sslabel +++| END 06439 M01S06436.sslabel +++| 06440 M01S06437.sslabel +++| REQCODE = REQTYP4"UNLD$CART"; 06441 M01S06438.sslabel +++| CALL4(REQCODE,DRD$NUM,CART$CSN,PT$Y[0],PT$Z[0],RESP$CODE); 06442 M01S06439.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4" 06443 M01S06440.sslabel +++| THEN # PUT FAILS # 06444 M01S06441.sslabel +++| BEGIN 06445 M01S06442.sslabel +++| DLABFLD; # DISPLAY LABEL FIELDS # 06446 M01S06443.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4"); 06447 M01S06444.sslabel +++| END 06448 M01S06445.sslabel +++| 06449 M01S06446.sslabel +++| RETURN; 06450 M01S06447.sslabel +++| 06451 M01S06448.sslabel +++| END # LBRSMSC # 06452 M01S06449.sslabel +++| 06453 M01S06450.sslabel +++| TERM 06454 M01S06451.sslabel +++|PROC LBSTCLR; 06455 M01S06452.sslabel +++|# TITLE LBSTCLR - STORES A *CE* CARTRIDGE IN 0,0 OR 0,15. # 06456 M01S06453.sslabel +++| 06457 M01S06454.sslabel +++| BEGIN # LBSTCLR # 06458 M01S06455.sslabel +++| 06459 M01S06456.sslabel +++|# 06460 M01S06457.sslabel +++|** LBSTCLR - STORES A *CE* CARTRIDGE IN 0,0 OR 0,15. 06461 M01S06458.sslabel +++|* 06462 M01S06459.sslabel +++|* THIS PROC STORES A SPECIAL CARTRIDGE IN ONE OF TWO SPECIFIC 06463 M01S06460.sslabel +++|* LOCATIONS. 06464 M01S06461.sslabel +++|* 06465 M01S06462.sslabel +++|* PROC LBSTCLR. 06466 M01S06463.sslabel +++|* 06467 M01S06464.sslabel +++|* ENTRY (LBARG$CC) = IF EQUAL TO 0, STORE CARTRIDGE FROM 06468 M01S06465.sslabel +++|* DRAWER TO LOCATION 0,0. 06469 M01S06466.sslabel +++|* IF EQUAL TO 15, STORE INTO 0,15. 06470 M01S06467.sslabel +++|* 06471 M01S06468.sslabel +++|* EXIT CARTRIDGE IN LOCATION SPECIFIED. 06472 M01S06469.sslabel +++|* 06473 M01S06470.sslabel +++|# 06474 M01S06471.sslabel +++| 06475 M01S06472.sslabel +++| DEF LISTCON #0#; # DO NOT DEF LIST COMDECKS # 06476 M01S06473.sslabel +++| 06477 M01S06474.sslabel +++|# 06478 M01S06475.sslabel +++|**** PROC LBSTCLR - XREF LIST BEGIN. 06479 M01S06476.sslabel +++|# 06480 M01S06477.sslabel +++| 06481 M01S06478.sslabel +++| XREF 06482 M01S06479.sslabel +++| BEGIN 06483 M01S06480.sslabel +++| PROC CALL4; # MAKE TYPE 4 REQUESTS # 06484 M01S06481.sslabel +++| PROC CKLAB; # CHECK LABEL # 06485 M01S06482.sslabel +++| PROC GENLAB; # GENERATE CARTRIDGE LABEL # 06486 M01S06483.sslabel +++| PROC LBERR; # PROCESS ERROR RESPONSE # 06487 M01S06484.sslabel +++| PROC LBRESP; # PROCESS ERROR FROM EXEC # 06488 M01S06485.sslabel +++| PROC SERCSU; # SEARCH SMMAP # 06489 M01S06486.sslabel +++| END 06490 M01S06487.sslabel +++| 06491 M01S06488.sslabel +++|# 06492 M01S06489.sslabel +++|**** PROC LBSTCLR - XREF LIST END. 06493 M01S06490.sslabel +++|# 06494 M01S06491.sslabel +++| 06495 M01S06492.sslabel +++|*CALL COMBFAS 06496 M01S06493.sslabel +++|*CALL COMBCMD 06497 M01S06494.sslabel +++|*CALL COMBCPR 06498 M01S06495.sslabel +++|*CALL COMBLBL 06499 M01S06496.sslabel +++|*CALL COMBMAP 06500 M01S06497.sslabel +++|*CALL COMTERR 06501 M01S06498.sslabel +++|*CALL COMTLAB 06502 M01S06499.sslabel +++|*CALL COMTLBP 06503 M01S06500.sslabel +++| 06504 M01S06501.sslabel +++| ITEM FLAG U; # RESPONSE FLAG # 06505 M01S06502.sslabel +++| ITEM Y U; # Y COORDINATE # 06506 M01S06503.sslabel +++| ITEM Z U; # Z COORDINATE # 06507 M01S06504.sslabel +++| ITEM SERTYPE S:SERCH$TYPE; # TYPE OF SERACH # 06508 M01S06505.sslabel +++| 06509 M01S06506.sslabel +++| ARRAY PT$CSU$ENT [0:0] P(4); # *PUT* SMMAP ENTRY # 06510 M01S06507.sslabel +++| BEGIN 06511 M01S06508.sslabel +++| ITEM PT$MAPENT C(00,00,30); # THREE WORD MAP ENTRY # 06512 M01S06509.sslabel +++| ITEM PT$Y U(03,00,30); # Y COORDINATE # 06513 M01S06510.sslabel +++| ITEM PT$Z U(03,30,30); # Z COORDINATE # 06514 M01S06511.sslabel +++| END 06515 M01S06512.sslabel +++| 06516 M01S06513.sslabel +++| CONTROL EJECT; 06517 M01S06514.sslabel +++| 06518 M01S06515.sslabel +++|# 06519 M01S06516.sslabel +++|* LOAD CARTRIDGE FROM INPUT DRAWER AND READ LABEL. 06520 M01S06517.sslabel +++|# 06521 M01S06518.sslabel +++| 06522 M01S06519.sslabel +++| Y = SM$ENT$TY; 06523 M01S06520.sslabel +++| Z = SM$TY$Z; 06524 M01S06521.sslabel +++| CALL4(REQTYP4"LOAD$CART",0,0,Y,Z,FLAG); 06525 M01S06522.sslabel +++| IF FLAG NQ RESPTYP4"OK4" ## 06526 M01S06523.sslabel +++| AND FLAG NQ RESPTYP4"UNK$CART" ## 06527 M01S06524.sslabel +++| AND FLAG NQ RESPTYP4"CART$LB$ERR" 06528 M01S06525.sslabel +++| THEN 06529 M01S06526.sslabel +++| BEGIN 06530 M01S06527.sslabel +++| CALL4(REQTYP4"UNLD$CART",0,0,SM$EXIT$TY,Z,FLAG); 06531 M01S06528.sslabel +++| IF FLAG NQ RESPTYP4"OK4" 06532 M01S06529.sslabel +++| THEN 06533 M01S06530.sslabel +++| BEGIN 06534 M01S06531.sslabel +++| LBRESP(FLAG,TYP"TYP4"); 06535 M01S06532.sslabel +++| END 06536 M01S06533.sslabel +++| 06537 M01S06534.sslabel +++| ERRCODE = S"M86$HARDWR"; 06538 M01S06535.sslabel +++| LBERR(ERRCODE); 06539 M01S06536.sslabel +++| RETURN; 06540 M01S06537.sslabel +++| END 06541 M01S06538.sslabel +++| 06542 M01S06539.sslabel +++|# 06543 M01S06540.sslabel +++|* SERACH SMMAP FOR DUPLICATE *CSN*. 06544 M01S06541.sslabel +++|# 06545 M01S06542.sslabel +++| 06546 M01S06543.sslabel +++| SERTYPE = S"CSN$MATCH"; 06547 M01S06544.sslabel +++| SERCSU(SERTYPE,0,0,0,LAB$CSND[0],0,0,PT$CSU$ENT[0],FLAG); 06548 M01S06545.sslabel +++| IF FLAG EQ 0 06549 M01S06546.sslabel +++| THEN # *CSN* IN MAP # 06550 M01S06547.sslabel +++| BEGIN 06551 M01S06548.sslabel +++| CALL4(REQTYP4"UNLD$CART",0,0,SM$EXIT$TY,SM$TY$Z,FLAG); 06552 M01S06549.sslabel +++| IF FLAG NQ RESPTYP4"OK4" 06553 M01S06550.sslabel +++| THEN 06554 M01S06551.sslabel +++| BEGIN 06555 M01S06552.sslabel +++| LBRESP(FLAG,TYP"TYP4"); 06556 M01S06553.sslabel +++| RETURN; 06557 M01S06554.sslabel +++| END 06558 M01S06555.sslabel +++| 06559 M01S06556.sslabel +++| ERRCODE = S"DUPL$CSN"; 06560 M01S06557.sslabel +++| LBERR(ERRCODE); 06561 M01S06558.sslabel +++| RETURN; 06562 M01S06559.sslabel +++| END 06563 M01S06560.sslabel +++| 06564 M01S06561.sslabel +++| 06565 M01S06562.sslabel +++|# 06566 M01S06563.sslabel +++|* PUT CARTRIDGE BACK TO DRAWER IF LABEL IS FROM FAMILY OR POOL. 06567 M01S06564.sslabel +++|# 06568 M01S06565.sslabel +++| 06569 M01S06566.sslabel +++| P<LABEL$CART> = OLDLABP; 06570 M01S06567.sslabel +++| CKLAB(FLAG); 06571 M01S06568.sslabel +++| IF FLAG EQ LABTYPE"FAM$LAB" ## 06572 M01S06569.sslabel +++| THEN 06573 M01S06570.sslabel +++| BEGIN 06574 M01S06571.sslabel +++| ERRCODE = S"GOOD$LAB"; 06575 M01S06572.sslabel +++| LBERR(ERRCODE); 06576 M01S06573.sslabel +++| RETURN; 06577 M01S06574.sslabel +++| END 06578 M01S06575.sslabel +++| 06579 M01S06576.sslabel +++| 06580 M01S06577.sslabel +++|# 06581 M01S06578.sslabel +++|* GENERATE NEW LABEL. 06582 M01S06579.sslabel +++|# 06583 M01S06580.sslabel +++| 06584 M01S06581.sslabel +++| P<SMUMAP> = LOC(PT$CSU$ENT[0]); 06585 M01S06582.sslabel +++| PT$Y[0] = 0; 06586 M01S06583.sslabel +++| PT$Z[0] = LBARG$CC[0]; 06587 M01S06584.sslabel +++| CM$SUB[0] = 0; 06588 M01S06585.sslabel +++| CM$FMLYNM[0] = " "; 06589 M01S06586.sslabel +++| GENLAB(LABTYPE"SCR$LAB",PT$CSU$ENT[0],0,0,0,0,0,0); 06590 M01S06587.sslabel +++| LAB$CLF[0] = 2; 06591 M01S06588.sslabel +++| LAB$RCORD[0] = 6652; 06592 M01S06589.sslabel +++| 06593 M01S06590.sslabel +++|# 06594 M01S06591.sslabel +++|* STORE CARTRIDGE. 06595 M01S06592.sslabel +++|# 06596 M01S06593.sslabel +++| 06597 M01S06594.sslabel +++| CALL4(REQTYP4"WRT$LAB",0,0,PT$Y[0],PT$Z[0],FLAG); 06598 M01S06595.sslabel +++| IF FLAG NQ RESPTYP4"OK4" 06599 M01S06596.sslabel +++| THEN 06600 M01S06597.sslabel +++| BEGIN 06601 M01S06598.sslabel +++| LBRESP(FLAG,TYP"TYP4"); 06602 M01S06599.sslabel +++| RETURN; 06603 M01S06600.sslabel +++| END 06604 M01S06601.sslabel +++| 06605 M01S06602.sslabel +++| 06606 M01S06603.sslabel +++| END 06607 M01S06604.sslabel +++| 06608 M01S06605.sslabel +++| TERM 06609 M01S06606.sslabel +++|PROC SERAST(FCTORD,FLAG); 06610 M01S06607.sslabel +++|# TITLE SERAST - SEARCHES THE AST FOR AN EMPTY CARTRIDGE. # 06611 M01S06608.sslabel +++| 06612 M01S06609.sslabel +++| BEGIN # SERAST # 06613 M01S06610.sslabel +++| 06614 M01S06611.sslabel +++|# 06615 M01S06612.sslabel +++|** SERAST - SEARCHES THE AST FOR AN EMPTY CARTRIDGE. 06616 M01S06613.sslabel +++|* 06617 M01S06614.sslabel +++|* THIS PROC READS THE *AST* AND IFNDS THE FIRST EMPTY 06618 M01S06615.sslabel +++|* CARTRIDGE IN A SPECIFIED GROUP. 06619 M01S06616.sslabel +++|* 06620 M01S06617.sslabel +++|* PROC SERAST(FCTORD,FLAG) 06621 M01S06618.sslabel +++|* 06622 M01S06619.sslabel +++|* ENTRY (LB$BUFP) = FWA OF A BUFFER 1101B WORDS LONG. 06623 M01S06620.sslabel +++|* (GROUP) = IF GROUP = 0 THEN THE GROUP PARAMETER 06624 M01S06621.sslabel +++|* IS IGNORED. OTHERWISE, SELECT FROM THE 06625 M01S06622.sslabel +++|* SPECIFIED GROUP.
Proceed to Part 3
cdc/nos2.source/opl.opl871/deck/sslabel.002.txt · Last modified: by 127.0.0.1