1 Modification
Listing Sections
Seq # *Modification Id* Act ----------------------------+ 02138 M00S02138.sslabel +++| 02139 M00S02139.sslabel +++| IF LBARG$PT[0] EQ "P" 02140 M00S02140.sslabel +++| THEN # ADD CARTRIDGE TO POOL # 02141 M00S02141.sslabel +++| BEGIN # POOL SEARCH # 02142 M00S02142.sslabel +++| SERTYPE = S"ASSIGN"; 02143 M00S02143.sslabel +++| SP$FAM = " "; # SEARCH FOR AN EMPTY CUBE # 02144 M00S02144.sslabel +++| SP$SUB = 0; 02145 M00S02145.sslabel +++| SP$VSN = " "; 02146 M00S02146.sslabel +++| SP$CODE = CUBSTAT"SCRPOOL"; 02147 M00S02147.sslabel +++| SERCSU(SERTYPE,0,0,SP$CODE,SP$VSN,SP$FAM,SP$SUB, ## 02148 M00S02148.sslabel +++| PT$CSU$ENT[0],SERFLAG); 02149 M00S02149.sslabel +++| IF SERFLAG 02150 M00S02150.sslabel +++| THEN # NO EMPTY CUBE IN POOL # 02151 M00S02151.sslabel +++| BEGIN 02152 M00S02152.sslabel +++| NUMDONE = I - 1; 02153 M00S02153.sslabel +++| ERRCODE = S"NO$EMPCBFP"; 02154 M00S02154.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING # 02155 M00S02155.sslabel +++| RETURN; 02156 M00S02156.sslabel +++| END 02157 M00S02157.sslabel +++| 02158 M00S02158.sslabel +++| END # POOL SEARCH # 02159 M00S02159.sslabel +++| 02160 M00S02160.sslabel +++|# 02161 M00S02161.sslabel +++|* SEARCH FOR CARTRIDGE TO BE ADDED. 02162 M00S02162.sslabel +++|# 02163 M00S02163.sslabel +++| 02164 M00S02164.sslabel +++| 02165 M00S02165.sslabel +++| IF LBARG$PK[0] EQ "P" AND LBARG$C[0] EQ 0 02166 M00S02166.sslabel +++| THEN 02167 M00S02167.sslabel +++| BEGIN # SEARCH POOL FOR ANY CARTRIDGE # 02168 M00S02168.sslabel +++| SERTYPE = S"CART$POOL"; 02169 M00S02169.sslabel +++| SERCSU(SERTYPE,0,0,0,0,0,0,PK$CSU$ENT[0],SERFLAG); 02170 M00S02170.sslabel +++| IF SERFLAG 02171 M00S02171.sslabel +++| THEN # POOL EMPTY # 02172 M00S02172.sslabel +++| BEGIN 02173 M00S02173.sslabel +++| NUMDONE = I - 1; 02174 M00S02174.sslabel +++| ERRCODE = S"NO$CR$PL"; 02175 M00S02175.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING # 02176 M00S02176.sslabel +++| RETURN; 02177 M00S02177.sslabel +++| END 02178 M00S02178.sslabel +++| 02179 M00S02179.sslabel +++| END # SEARCH POOL FOR ANY CARTRIDGE # 02180 M00S02180.sslabel +++| 02181 M00S02181.sslabel +++| IF LBARG$C[0] NQ 0 02182 M00S02182.sslabel +++| THEN 02183 M00S02183.sslabel +++| BEGIN # SEARCH POOL FOR VSN # 02184 M00S02184.sslabel +++| SERTYPE = S"CSN$MATCH"; 02185 M00S02185.sslabel +++| SERCSU(SERTYPE,0,0,0,LBARG$C[0],0,0,PK$CSU$ENT[0],SERFLAG); 02186 M00S02186.sslabel +++| IF SERFLAG 02187 M00S02187.sslabel +++| THEN # VSN NOT FOUND # 02188 M00S02188.sslabel +++| BEGIN 02189 M00S02189.sslabel +++| ERRCODE = S"CSN$NOTFND"; 02190 M00S02190.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING # 02191 M00S02191.sslabel +++| RETURN; 02192 M00S02192.sslabel +++| END 02193 M00S02193.sslabel +++| 02194 M00S02194.sslabel +++| ELSE # VSN FOUND # 02195 M00S02195.sslabel +++| BEGIN 02196 M00S02196.sslabel +++| P<SMUMAP> = LOC(PK$CSU$ENT[0]); 02197 M00S02197.sslabel +++| IF CM$CODE[0] NQ CUBSTAT"SCRPOOL" 02198 M00S02198.sslabel +++| THEN # CARTRIDGE NOT ASSIGNED TO POOL # 02199 M00S02199.sslabel +++| BEGIN 02200 M00S02200.sslabel +++| ERRCODE = S"UNX$CR$ASN"; 02201 M00S02201.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING # 02202 M00S02202.sslabel +++| RETURN; 02203 M00S02203.sslabel +++| END 02204 M00S02204.sslabel +++| 02205 M00S02205.sslabel +++| END 02206 M00S02206.sslabel +++| 02207 M00S02207.sslabel +++| END # SEARCH POOL FOR VSN # 02208 M00S02208.sslabel +++| 02209 M00S02209.sslabel +++| IF LBARG$PK[0] EQ "D" 02210 M00S02210.sslabel +++| THEN # SET COORDINATES TO CAS ENTRY # 02211 M00S02211.sslabel +++| BEGIN 02212 M00S02212.sslabel +++| PK$Y[0] = SM$ENT$TY; 02213 M00S02213.sslabel +++| PK$Z[0] = 0; 02214 M00S02214.sslabel +++| END 02215 M00S02215.sslabel +++| 02216 M00S02216.sslabel +++| 02217 M00S02217.sslabel +++|# 02218 M00S02218.sslabel +++|* LOAD CARTRIDGE AND READ THE LABEL. 02219 M00S02219.sslabel +++|# 02220 M00S02220.sslabel +++| 02221 M00S02221.sslabel +++| CALL4(REQTYP4"LOAD$CART",DRD$NUM,CART$CSN,PK$Y[0], PK$Z[0], 02222 M00S02222.sslabel +++| FLAG); 02223 M00S02223.sslabel +++| IF FLAG NQ RESPTYP4"OK4" ## 02224 M00S02224.sslabel +++| AND FLAG NQ RESPTYP4"UNK$CART" 02225 M00S02225.sslabel +++| THEN 02226 M00S02226.sslabel +++| BEGIN # LOAD FAILS # 02227 M00S02227.sslabel +++| P<SMUMAP> = LOC(PK$CSU$ENT[0]); 02228 M00S02228.sslabel +++| IF FLAG EQ RESPTYP4"CELL$EMP" ## 02229 M00S02229.sslabel +++| AND CM$CODE[0] EQ CUBSTAT"SCRPOOL" 02230 M00S02230.sslabel +++| THEN 02231 M00S02231.sslabel +++| BEGIN # SET ERROR FLAG IN SMMAP ENTRY # 02232 M00S02232.sslabel +++| CM$FLAG1[0] = TRUE; 02233 M00S02233.sslabel +++| CALL3(REQTYP3"UPD$MAP",PK$CSU$ENT[0],0,0,FLAG); 02234 M00S02234.sslabel +++| NUMDONE = I - 1; 02235 M00S02235.sslabel +++| ERRCODE = S"CR$NOTFND"; # CARTRIDGE NOT FOUND # 02236 M00S02236.sslabel +++| LBERR(ERRCODE); 02237 M00S02237.sslabel +++| IF FLAG NQ RESPTYP3"OK3" 02238 M00S02238.sslabel +++| THEN 02239 M00S02239.sslabel +++| BEGIN 02240 M00S02240.sslabel +++| LBRESP(FLAG,TYP"TYP3"); 02241 M00S02241.sslabel +++| END 02242 M00S02242.sslabel +++| 02243 M00S02243.sslabel +++| RETURN; 02244 M00S02244.sslabel +++| END # SET ERROR FLAG IN SMMAP ENTRY # 02245 M00S02245.sslabel +++| 02246 M00S02246.sslabel +++| P<LABEL$CART> = OLDLABP; 02247 M00S02247.sslabel +++| IF FLAG EQ RESPTYP4"UNK$CART" 02248 M00S02248.sslabel +++| AND LAB$CARTTP[0] NQ 0 02249 M00S02249.sslabel +++| THEN # *CSN* MISMATCH # 02250 M00S02250.sslabel +++| BEGIN 02251 M00S02251.sslabel +++| LBRESP(FLAG,TYP"TYP4"); 02252 M00S02252.sslabel +++| RETURN; 02253 M00S02253.sslabel +++| END 02254 M00S02254.sslabel +++| 02255 M00S02255.sslabel +++| ELSE # PROCESS THE RESPONSE CODE # 02256 M00S02256.sslabel +++| BEGIN 02257 M00S02257.sslabel +++| LBRESP(FLAG,TYP"TYP4"); 02258 M00S02258.sslabel +++| RETURN; 02259 M00S02259.sslabel +++| END 02260 M00S02260.sslabel +++| 02261 M00S02261.sslabel +++| END # LOAD FAILS # 02262 M00S02262.sslabel +++| 02263 M00S02263.sslabel +++| 02264 M00S02264.sslabel +++| CKLAB(FLAG); # CHECK LABEL TYPE # 02265 M00S02265.sslabel +++| P<LABEL$CART> = OLDLABP; 02266 M00S02266.sslabel +++| IF (FLAG NQ LABTYPE"MAN$LAB" ## 02267 M00S02267.sslabel +++| AND FLAG NQ LABTYPE"SCR$LAB") ## 02268 M00S02268.sslabel +++| THEN # UNKNOWN LABEL TYPE # 02269 M00S02269.sslabel +++| BEGIN 02270 M00S02270.sslabel +++| CALL4(REQTYP4"UNLD$CART",0,0,SM$EXIT$TY,SM$TY$Z,RESP$CODE); 02271 M00S02271.sslabel +++| IF RESP$CODE NQ 0 02272 M00S02272.sslabel +++| THEN 02273 M00S02273.sslabel +++| BEGIN 02274 M00S02274.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4"); 02275 M00S02275.sslabel +++| RETURN; 02276 M00S02276.sslabel +++| END 02277 M00S02277.sslabel +++| 02278 M00S02278.sslabel +++| ERRCODE = S"UNKNWN$LAB"; 02279 M00S02279.sslabel +++| LBERR(ERRCODE); 02280 M00S02280.sslabel +++| TEST I; 02281 M00S02281.sslabel +++| END 02282 M00S02282.sslabel +++| 02283 M00S02283.sslabel +++| LD$CNT = LAB$CRLD[0]; # USE OLD COUNTS # 02284 M00S02284.sslabel +++| LD$ERR = LAB$LDER[0]; 02285 M00S02285.sslabel +++| SR$ERR = LAB$SRDE[0]; 02286 M00S02286.sslabel +++| SW$ERR = LAB$SWRE1[0]; 02287 M00S02287.sslabel +++| B<28,4>SW$ERR = LAB$SWRE; 02288 M00S02288.sslabel +++| HR$ERR = LAB$HRDE[0]; 02289 M00S02289.sslabel +++| STR$RD = LAB$STRD[0]; 02290 M00S02290.sslabel +++| STR$WR = LAB$STWR1[0]; 02291 M00S02291.sslabel +++| B<36,24>STR$WR = LAB$STWR[0]; 02292 M00S02292.sslabel +++| STR$DM = LAB$STDM[0]; 02293 M00S02293.sslabel +++| 02294 M00S02294.sslabel +++| IF LBARG$PK[0] NQ "D" 02295 M00S02295.sslabel +++| THEN 02296 M00S02296.sslabel +++| BEGIN # VERIFY VSN, Y, Z IN THE LABEL # 02297 M00S02297.sslabel +++| P<LABEL$CART> = OLDLABP; 02298 M00S02298.sslabel +++| P<SMUMAP> = LOC(PK$CSU$ENT[0]); 02299 M00S02299.sslabel +++| IF LAB$CSND[0] NQ CM$CSND[0] ## 02300 M00S02300.sslabel +++| AND (LAB$Y[0] NQ PK$Y[0] OR LAB$Z[0] NQ PK$Z[0]) 02301 M00S02301.sslabel +++| THEN 02302 M00S02302.sslabel +++| BEGIN # TEST Y,Z # 02303 M00S02303.sslabel +++| REQCODE = REQTYP4"UNLD$CART"; 02304 M00S02304.sslabel +++| CALL4(REQCODE,0,0,SM$EXIT$TY,SM$TY$Z,RESP$CODE); 02305 M00S02305.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4" 02306 M00S02306.sslabel +++| THEN 02307 M00S02307.sslabel +++| BEGIN 02308 M00S02308.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4"); 02309 M00S02309.sslabel +++| RETURN; 02310 M00S02310.sslabel +++| END 02311 M00S02311.sslabel +++| 02312 M00S02312.sslabel +++| ERRCODE = S"M86$HARDWR"; # MSF HARDWARE PROBLEM # 02313 M00S02313.sslabel +++| LBERR(ERRCODE); 02314 M00S02314.sslabel +++| RETURN; 02315 M00S02315.sslabel +++| END # TEST Y,Z # 02316 M00S02316.sslabel +++| 02317 M00S02317.sslabel +++| END # VERIFY VSN, Y, Z IN THE LABEL # 02318 M00S02318.sslabel +++| 02319 M00S02319.sslabel +++|# 02320 M00S02320.sslabel +++|* GENERATE NEW CARTRIDGE LABEL 02321 M00S02321.sslabel +++|# 02322 M00S02322.sslabel +++| 02323 M00S02323.sslabel +++| IF LBARG$PT[0] EQ "P" 02324 M00S02324.sslabel +++| THEN # SET UP SCRATCH LABEL # 02325 M00S02325.sslabel +++| BEGIN 02326 M00S02326.sslabel +++| GENLAB(LABTYPE"SCR$LAB",PT$CSU$ENT[0],LD$CNT,LD$ERR, SR$ERR, 02327 M00S02327.sslabel +++| SW$ERR,HR$ERR,STR$RD,STR$WR,STR$DM); 02328 M00S02328.sslabel +++| END 02329 M00S02329.sslabel +++| 02330 M00S02330.sslabel +++| ELSE # SET UP FAMILY LABEL # 02331 M00S02331.sslabel +++| BEGIN 02332 M00S02332.sslabel +++| GENLAB(LABTYPE"FAM$LAB",PT$CSU$ENT[0],LD$CNT,LD$ERR, SR$ERR, 02333 M00S02333.sslabel +++| SW$ERR,HR$ERR,STR$RD,STR$WR,STR$DM); 02334 M00S02334.sslabel +++| END 02335 M00S02335.sslabel +++| 02336 M00S02336.sslabel +++|# 02337 M00S02337.sslabel +++|* UPDATE THE CARTRIDGE LOAD AND PASS COUNTS IN THE 02338 M00S02338.sslabel +++|* NEW LABEL. 02339 M00S02339.sslabel +++|# 02340 M00S02340.sslabel +++| 02341 M00S02341.sslabel +++| P<LABEL$CART> = NEWLABP; 02342 M00S02342.sslabel +++| LAB$CRLD[0] = LAB$CRLD[0] + 1; 02343 M00S02343.sslabel +++| IF B<0,8>LAB$CSN[0] NQ X"C9" ## 02344 M00S02344.sslabel +++| OR B<8,8>LAB$CSN[0] NQ X"C2" OR B<16,8>LAB$CSN[0] NQ X"D4" 02345 M00S02345.sslabel +++| THEN # CARTRIDGE NOT IBM # 02346 M00S02346.sslabel +++| BEGIN 02347 M00S02347.sslabel +++| LAB$CCOD[0] = OTHCART; 02348 M00S02348.sslabel +++| END 02349 M00S02349.sslabel +++| 02350 M00S02350.sslabel +++| ELSE 02351 M00S02351.sslabel +++| BEGIN 02352 M00S02352.sslabel +++| LAB$CCOD[0] = IBMCART; 02353 M00S02353.sslabel +++| END 02354 M00S02354.sslabel +++| 02355 M00S02355.sslabel +++| 02356 M00S02356.sslabel +++|# 02357 M00S02357.sslabel +++|* IF THE CARTRIDGE IS FROM THE INPUT DRAWER, ENSURE THAT 02358 M00S02358.sslabel +++|* THE VSN IS NOT ALREADY IN THE SMUMAP. 02359 M00S02359.sslabel +++|# 02360 M00S02360.sslabel +++| 02361 M00S02361.sslabel +++| IF LBARG$PK[0] EQ "D" 02362 M00S02362.sslabel +++| THEN 02363 M00S02363.sslabel +++| BEGIN # CHECK FOR DUPLICATE VSN # 02364 M00S02364.sslabel +++| SERTYPE = S"CSN$MATCH"; 02365 M00S02365.sslabel +++| SERCSU(SERTYPE,0,0,0,LAB$CSND[0],0,0, PK$CSU$ENT[0],SERFLAG) 02366 M00S02366.sslabel +++| ; 02367 M00S02367.sslabel +++| IF NOT SERFLAG 02368 M00S02368.sslabel +++| THEN # VSN ALREADY IN SMMAP # 02369 M00S02369.sslabel +++| BEGIN 02370 M00S02370.sslabel +++| REQCODE = REQTYP4"UNLD$CART"; 02371 M00S02371.sslabel +++| CALL4(REQCODE,0,0,SM$EXIT$TY,SM$TY$Z,RESP$CODE); 02372 M00S02372.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4" 02373 M00S02373.sslabel +++| THEN 02374 M00S02374.sslabel +++| BEGIN 02375 M00S02375.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4"); 02376 M00S02376.sslabel +++| RETURN; 02377 M00S02377.sslabel +++| END 02378 M00S02378.sslabel +++| 02379 M00S02379.sslabel +++| ERRCODE = S"DUPL$CSN"; 02380 M00S02380.sslabel +++| LBERR(ERRCODE); 02381 M00S02381.sslabel +++| RETURN; 02382 M00S02382.sslabel +++| END 02383 M00S02383.sslabel +++| 02384 M00S02384.sslabel +++| END # CHECK FOR DUPLICATE VSN # 02385 M00S02385.sslabel +++| 02386 M00S02386.sslabel +++| 02387 M00S02387.sslabel +++|# 02388 M00S02388.sslabel +++|* IF CARTRIDGE PICKED FROM POOL, UPDATE SMMAP ENTRY AND AST FOR 02389 M00S02389.sslabel +++|* NOW EMPTY CUBE IN POOL. 02390 M00S02390.sslabel +++|# 02391 M00S02391.sslabel +++| 02392 M00S02392.sslabel +++| IF LBARG$PK[0] NQ "D" 02393 M00S02393.sslabel +++| THEN # PICKED FROM POOL # 02394 M00S02394.sslabel +++| BEGIN 02395 M00S02395.sslabel +++| P<SMUMAP> = LOC(PK$CSU$ENT[0]); 02396 M00S02396.sslabel +++| CM$CCOD[0] = " "; 02397 M00S02397.sslabel +++| CM$CSND[0] = " "; # CLEAR VSN FIELD # 02398 M00S02398.sslabel +++| CALL3(REQTYP3"UPD$MAP",PK$CSU$ENT[0],0,0,FLAG); 02399 M00S02399.sslabel +++| IF FLAG NQ RESPTYP3"OK3" 02400 M00S02400.sslabel +++| THEN # MAP UPDATE FAILS # 02401 M00S02401.sslabel +++| BEGIN 02402 M00S02402.sslabel +++| REQCODE = REQTYP4"UNLD$CART"; 02403 M00S02403.sslabel +++| CALL4(REQCODE,0,0,PK$Y[0],PK$Z[0],RESP$CODE); 02404 M00S02404.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4" 02405 M00S02405.sslabel +++| THEN 02406 M00S02406.sslabel +++| BEGIN 02407 M00S02407.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4"); 02408 M00S02408.sslabel +++| RETURN; 02409 M00S02409.sslabel +++| END 02410 M00S02410.sslabel +++| 02411 M00S02411.sslabel +++| LBRESP(FLAG,TYP"TYP3"); # PROCESS ERROR CODE # 02412 M00S02412.sslabel +++| RETURN; 02413 M00S02413.sslabel +++| END 02414 M00S02414.sslabel +++| 02415 M00S02415.sslabel +++| END 02416 M00S02416.sslabel +++| 02417 M00S02417.sslabel +++|# 02418 M00S02418.sslabel +++|* WRITE NEW LABEL. 02419 M00S02419.sslabel +++|# 02420 M00S02420.sslabel +++| 02421 M00S02421.sslabel +++| CALL4(REQTYP4"WRT$LAB",DRD$NUM,CART$CSN,PT$Y[0],PT$Z[0], FLAG) 02422 M00S02422.sslabel +++| ; 02423 M00S02423.sslabel +++| IF FLAG NQ RESPTYP4"OK4" 02424 M00S02424.sslabel +++| THEN # WRITE FAILS # 02425 M00S02425.sslabel +++| BEGIN 02426 M00S02426.sslabel +++| LBRESP(FLAG,TYP"TYP4"); # PROCESS THE RESPONSE CODE # 02427 M00S02427.sslabel +++| RETURN; 02428 M00S02428.sslabel +++| END 02429 M00S02429.sslabel +++| 02430 M00S02430.sslabel +++|# 02431 M00S02431.sslabel +++|* UPDATE SMMAP ENTRY FOR NEW LOCATION OF CARTRIDGE. 02432 M00S02432.sslabel +++|# 02433 M00S02433.sslabel +++| 02434 M00S02434.sslabel +++| P<SMUMAP> = LOC(PT$CSU$ENT[0]); 02435 M00S02435.sslabel +++| IF LBARG$PT[0] EQ "P" 02436 M00S02436.sslabel +++| THEN # ADD CARTRIDGE TO POOL # 02437 M00S02437.sslabel +++| BEGIN 02438 M00S02438.sslabel +++| P<LABEL$CART> = NEWLABP; 02439 M00S02439.sslabel +++| CM$CCOD[0] = LAB$CCOD[0]; 02440 M00S02440.sslabel +++| CM$CSND[0] = LAB$CSND[0]; # UPDATE VSN IN MAP ENTRY # 02441 M00S02441.sslabel +++| CALL3(REQTYP3"UPD$MAP",PT$CSU$ENT[0],0,0,FLAG); 02442 M00S02442.sslabel +++| END 02443 M00S02443.sslabel +++| 02444 M00S02444.sslabel +++| IF LBARG$PT[0] EQ "F" 02445 M00S02445.sslabel +++| THEN # ADD CARTRIDGE TO FAMILY # 02446 M00S02446.sslabel +++| BEGIN 02447 M00S02447.sslabel +++| CALL3(REQTYP3"ADD$CART",PT$CSU$ENT[0],0,0,FLAG); 02448 M00S02448.sslabel +++| END 02449 M00S02449.sslabel +++| 02450 M00S02450.sslabel +++| IF FLAG NQ RESPTYP3"OK3" 02451 M00S02451.sslabel +++| THEN # ADD TO FAMILY FAILS # 02452 M00S02452.sslabel +++| BEGIN 02453 M00S02453.sslabel +++| LBRESP(FLAG,TYP"TYP3"); # PROCESS THE RESPONSE CODE # 02454 M00S02454.sslabel +++| RETURN; 02455 M00S02455.sslabel +++| END 02456 M00S02456.sslabel +++| 02457 M00S02457.sslabel +++| 02458 M00S02458.sslabel +++| 02459 M00S02459.sslabel +++| MFLUSH; # FLUSH MAP BUFFER # 02460 M00S02460.sslabel +++| END # LBADMSC PROCESSING # 02461 M00S02461.sslabel +++| 02462 M00S02462.sslabel +++| RETURN; 02463 M00S02463.sslabel +++| 02464 M00S02464.sslabel +++| END # LBADMSC # 02465 M00S02465.sslabel +++| 02466 M00S02466.sslabel +++| TERM 02467 M00S02467.sslabel +++|PROC LBCONV(FLAG); 02468 M00S02468.sslabel +++|# TITLE LBCONV - CONVERT CRACKED PARAMETERS TO INTEGERS. # 02469 M00S02469.sslabel +++| 02470 M00S02470.sslabel +++| BEGIN # LBCONV # 02471 M00S02471.sslabel +++| 02472 M00S02472.sslabel +++|# 02473 M00S02473.sslabel +++|** LBCONV - CONVERT CRACKED PARAMETERS TO INTEGERS. 02474 M00S02474.sslabel +++|* 02475 M00S02475.sslabel +++|* THIS PROCEDURE CALLS *XDXB* TO CONVERT THE PARAMETERS 02476 M00S02476.sslabel +++|* IN DISPLAY CODE TO INTEGER VALUES. 02477 M00S02477.sslabel +++|* 02478 M00S02478.sslabel +++|* PROC LBCONV(FLAG) 02479 M00S02479.sslabel +++|* 02480 M00S02480.sslabel +++|* ENTRY DIRECTIVE PARAMETERS CRACKED AND 02481 M00S02481.sslabel +++|* PLACED IN COMMON AREA *ULBPCOM*. 02482 M00S02482.sslabel +++|* 02483 M00S02483.sslabel +++|* EXIT ALL THE PARAMETERS CONVERTED AND PLACED 02484 M00S02484.sslabel +++|* BACK IN *ULBPCOM*. 02485 M00S02485.sslabel +++|* FLAG, AN ITEM CONTAINING THE ERROR STATUS. 02486 M00S02486.sslabel +++|* 0, NO ERROR 02487 M00S02487.sslabel +++|* 1, CONVERSION ERROR 02488 M00S02488.sslabel +++|* 02489 M00S02489.sslabel +++|* NOTES PROC *LBCONV* CONVERTS EACH CRACKED 02490 M00S02490.sslabel +++|* PARAMETER FROM DISPLAY CODE TO INTEGER 02491 M00S02491.sslabel +++|* VALUE AND REPLACES IT BACK IN ITS 02492 M00S02492.sslabel +++|* ORIGINAL LOCATION. ANY PARAMETER NOT 02493 M00S02493.sslabel +++|* SPECIFIED IS SUBSTITUTED WITH ITS 02494 M00S02494.sslabel +++|* DEFAULT VALUE. 02495 M00S02495.sslabel +++|# 02496 M00S02496.sslabel +++| 02497 M00S02497.sslabel +++| ITEM FLAG I; # ERROR STATUS # 02498 M00S02498.sslabel +++| 02499 M00S02499.sslabel +++|# 02500 M00S02500.sslabel +++|**** PROC LBCONV - XREF LIST BEGIN. 02501 M00S02501.sslabel +++|# 02502 M00S02502.sslabel +++| 02503 M00S02503.sslabel +++| XREF 02504 M00S02504.sslabel +++| BEGIN 02505 M00S02505.sslabel +++| FUNC XDXB I; # CONVERT DISPLAY TO INTEGER # 02506 M00S02506.sslabel +++| END 02507 M00S02507.sslabel +++| 02508 M00S02508.sslabel +++|# 02509 M00S02509.sslabel +++|**** PROC LBCONV - XREF LIST END. 02510 M00S02510.sslabel +++|# 02511 M00S02511.sslabel +++| 02512 M00S02512.sslabel +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS # 02513 M00S02513.sslabel +++|*CALL COMBFAS 02514 M00S02514.sslabel +++|*CALL COMTLAB 02515 M00S02515.sslabel +++|*CALL COMTLBP 02516 M00S02516.sslabel +++| 02517 M00S02517.sslabel +++| ITEM TEMPR I; # TEMP ITEM # 02518 M00S02518.sslabel +++| ITEM TYPE I; # TYPE OF CONVERSION # 02519 M00S02519.sslabel +++| 02520 M00S02520.sslabel +++| CONTROL EJECT; 02521 M00S02521.sslabel +++| 02522 M00S02522.sslabel +++| TYPE = 1; # CONVERT FROM DISPLAY CODE TO 02523 M00S02523.sslabel +++| INTEGER VALUE # 02524 M00S02524.sslabel +++| 02525 M00S02525.sslabel +++|# 02526 M00S02526.sslabel +++|* CHECK THE VALUE OF *N*. 02527 M00S02527.sslabel +++|# 02528 M00S02528.sslabel +++| 02529 M00S02529.sslabel +++| IF LBARG$N[0] EQ 0 02530 M00S02530.sslabel +++| THEN # N OMITTED # 02531 M00S02531.sslabel +++| BEGIN 02532 M00S02532.sslabel +++| LBARG$N[0] = 1; # SET DEFAULT VALUE # 02533 M00S02533.sslabel +++| END 02534 M00S02534.sslabel +++| 02535 M00S02535.sslabel +++| IF LBARG$N[0] NQ 1 02536 M00S02536.sslabel +++| THEN # N SPECIFIED # 02537 M00S02537.sslabel +++| BEGIN 02538 M00S02538.sslabel +++| FLAG = XDXB(LBARG$N[0],TYPE,TEMPR); 02539 M00S02539.sslabel +++| IF FLAG NQ 0 02540 M00S02540.sslabel +++| THEN # CONVERSION ERROR # 02541 M00S02541.sslabel +++| BEGIN 02542 M00S02542.sslabel +++| RETURN; 02543 M00S02543.sslabel +++| END 02544 M00S02544.sslabel +++| 02545 M00S02545.sslabel +++| LBARG$N[0] = TEMPR; # RESET N # 02546 M00S02546.sslabel +++| END 02547 M00S02547.sslabel +++| 02548 M00S02548.sslabel +++|# 02549 M00S02549.sslabel +++|* CHECK THE VALUE OF *B*. 02550 M00S02550.sslabel +++|# 02551 M00S02551.sslabel +++| 02552 M00S02552.sslabel +++| IF LBARG$B[0] EQ 0 02553 M00S02553.sslabel +++| THEN # SET DEFAULT # 02554 M00S02554.sslabel +++| BEGIN 02555 M00S02555.sslabel +++| LBARG$B[0] = 600; 02556 M00S02556.sslabel +++| END 02557 M00S02557.sslabel +++| 02558 M00S02558.sslabel +++| IF LBARG$B[0] NQ 600 02559 M00S02559.sslabel +++| THEN # *B* IS SPECIFIED # 02560 M00S02560.sslabel +++| BEGIN 02561 M00S02561.sslabel +++| FLAG = XDXB(LBARG$B[0],TYPE,TEMPR); 02562 M00S02562.sslabel +++| IF FLAG NQ 0 02563 M00S02563.sslabel +++| THEN # CONVERSION ERROR # 02564 M00S02564.sslabel +++| BEGIN 02565 M00S02565.sslabel +++| RETURN; 02566 M00S02566.sslabel +++| END 02567 M00S02567.sslabel +++| 02568 M00S02568.sslabel +++| LBARG$B[0] = TEMPR; # RESET *B* # 02569 M00S02569.sslabel +++| END 02570 M00S02570.sslabel +++| 02571 M00S02571.sslabel +++|# 02572 M00S02572.sslabel +++|* SET THE VALUE OF *CC*. 02573 M00S02573.sslabel +++|# 02574 M00S02574.sslabel +++| 02575 M00S02575.sslabel +++| IF LBARG$CC[0] NQ 0 02576 M00S02576.sslabel +++| THEN 02577 M00S02577.sslabel +++| BEGIN 02578 M00S02578.sslabel +++| IF C<0,1>LBARG$CC[0] EQ "A" 02579 M00S02579.sslabel +++| THEN 02580 M00S02580.sslabel +++| BEGIN 02581 M00S02581.sslabel +++| LBARG$CC[0] = 0; 02582 M00S02582.sslabel +++| END 02583 M00S02583.sslabel +++| 02584 M00S02584.sslabel +++| IF C<0,1>LBARG$CC[0] EQ "B" 02585 M00S02585.sslabel +++| THEN 02586 M00S02586.sslabel +++| BEGIN 02587 M00S02587.sslabel +++| LBARG$CC[0] = 15; 02588 M00S02588.sslabel +++| END 02589 M00S02589.sslabel +++| 02590 M00S02590.sslabel +++| 02591 M00S02591.sslabel +++| END 02592 M00S02592.sslabel +++| 02593 M00S02593.sslabel +++| ELSE 02594 M00S02594.sslabel +++| BEGIN 02595 M00S02595.sslabel +++| LBARG$CC[0] = -1; 02596 M00S02596.sslabel +++| END 02597 M00S02597.sslabel +++| 02598 M00S02598.sslabel +++| 02599 M00S02599.sslabel +++| 02600 M00S02600.sslabel +++|# 02601 M00S02601.sslabel +++|* CHECK THE VALUE OF *CC*. 02602 M00S02602.sslabel +++|# 02603 M00S02603.sslabel +++| 02604 M00S02604.sslabel +++| IF LBARG$CM[0] EQ 0 02605 M00S02605.sslabel +++| THEN 02606 M00S02606.sslabel +++| BEGIN 02607 M00S02607.sslabel +++| LBARG$CM[0] = IBMCART; 02608 M00S02608.sslabel +++| END 02609 M00S02609.sslabel +++| 02610 M00S02610.sslabel +++| ELSE 02611 M00S02611.sslabel +++| BEGIN 02612 M00S02612.sslabel +++| B<6,6>LBARG$CM[0] = "-"; 02613 M00S02613.sslabel +++| END 02614 M00S02614.sslabel +++| 02615 M00S02615.sslabel +++| 02616 M00S02616.sslabel +++| 02617 M00S02617.sslabel +++|# 02618 M00S02618.sslabel +++|* CHECK THE VALUE OF *GR*. 02619 M00S02619.sslabel +++|# 02620 M00S02620.sslabel +++| 02621 M00S02621.sslabel +++| IF LBARG$GR[0] NQ 7777 02622 M00S02622.sslabel +++| THEN # VALUE IS SPECIFIED # 02623 M00S02623.sslabel +++| BEGIN 02624 M00S02624.sslabel +++| FLAG = XDXB(LBARG$GR[0],TYPE,TEMPR); 02625 M00S02625.sslabel +++| IF FLAG NQ 0 02626 M00S02626.sslabel +++| THEN # CONVERSION ERROR # 02627 M00S02627.sslabel +++| BEGIN 02628 M00S02628.sslabel +++| RETURN; 02629 M00S02629.sslabel +++| END 02630 M00S02630.sslabel +++| 02631 M00S02631.sslabel +++| LBARG$GR[0] = TEMPR; # RESET *GR* # 02632 M00S02632.sslabel +++| END 02633 M00S02633.sslabel +++| 02634 M00S02634.sslabel +++| ELSE # *GR* NOT SPECIFIED # 02635 M00S02635.sslabel +++| BEGIN 02636 M00S02636.sslabel +++| LBARG$GR[0] = -1; 02637 M00S02637.sslabel +++| END 02638 M00S02638.sslabel +++| 02639 M00S02639.sslabel +++| 02640 M00S02640.sslabel +++|# 02641 M00S02641.sslabel +++|* CHECK THE VALUE OF *YI*. 02642 M00S02642.sslabel +++|# 02643 M00S02643.sslabel +++| 02644 M00S02644.sslabel +++| IF LBARG$YI[0] NQ 0 AND LBARG$YI[0] NQ O"7777" 02645 M00S02645.sslabel +++| THEN 02646 M00S02646.sslabel +++| BEGIN 02647 M00S02647.sslabel +++| FLAG = XDXB(LBARG$YI[0],TYPE,TEMPR); 02648 M00S02648.sslabel +++| IF FLAG NQ 0 02649 M00S02649.sslabel +++| THEN # CONVERSION ERROR # 02650 M00S02650.sslabel +++| BEGIN 02651 M00S02651.sslabel +++| RETURN; 02652 M00S02652.sslabel +++| END 02653 M00S02653.sslabel +++| 02654 M00S02654.sslabel +++| LBARG$YI[0] = TEMPR; # RESET *YI* # 02655 M00S02655.sslabel +++| END 02656 M00S02656.sslabel +++| 02657 M00S02657.sslabel +++| ELSE 02658 M00S02658.sslabel +++| BEGIN 02659 M00S02659.sslabel +++| IF LBARG$YI[0] EQ 0 02660 M00S02660.sslabel +++| THEN # *YI* OMITTED # 02661 M00S02661.sslabel +++| BEGIN 02662 M00S02662.sslabel +++| LBARG$YI[0] = -1; # SET DEFAULT VALUE # 02663 M00S02663.sslabel +++| END 02664 M00S02664.sslabel +++| 02665 M00S02665.sslabel +++| END 02666 M00S02666.sslabel +++| 02667 M00S02667.sslabel +++|# 02668 M00S02668.sslabel +++|* CHECK THE VALUE OF *YF*. 02669 M00S02669.sslabel +++|# 02670 M00S02670.sslabel +++| 02671 M00S02671.sslabel +++| IF LBARG$YF[0] NQ 0 ## 02672 M00S02672.sslabel +++| AND LBARG$YF[0] NQ O"7777" 02673 M00S02673.sslabel +++| THEN 02674 M00S02674.sslabel +++| BEGIN 02675 M00S02675.sslabel +++| FLAG = XDXB(LBARG$YF[0],TYPE,TEMPR); 02676 M00S02676.sslabel +++| IF FLAG NQ 0 02677 M00S02677.sslabel +++| THEN # CONVERSION ERROR # 02678 M00S02678.sslabel +++| BEGIN 02679 M00S02679.sslabel +++| RETURN; 02680 M00S02680.sslabel +++| END 02681 M00S02681.sslabel +++| 02682 M00S02682.sslabel +++| LBARG$YF[0] = TEMPR; # RESET *YF* # 02683 M00S02683.sslabel +++| END 02684 M00S02684.sslabel +++| 02685 M00S02685.sslabel +++| ELSE 02686 M00S02686.sslabel +++| BEGIN 02687 M00S02687.sslabel +++| IF LBARG$YF[0] EQ 0 02688 M00S02688.sslabel +++| THEN # *YF* OMITTED # 02689 M00S02689.sslabel +++| BEGIN 02690 M00S02690.sslabel +++| LBARG$YF[0] = -1; # SET DEFAULT VALUE # 02691 M00S02691.sslabel +++| END 02692 M00S02692.sslabel +++| 02693 M00S02693.sslabel +++| END 02694 M00S02694.sslabel +++| 02695 M00S02695.sslabel +++|# 02696 M00S02696.sslabel +++|* CHECK THE VALUE OF *ZI*. 02697 M00S02697.sslabel +++|# 02698 M00S02698.sslabel +++| 02699 M00S02699.sslabel +++| IF LBARG$ZI[0] NQ 0 AND LBARG$ZI[0] NQ O"7777" 02700 M00S02700.sslabel +++| THEN 02701 M00S02701.sslabel +++| BEGIN 02702 M00S02702.sslabel +++| FLAG = XDXB(LBARG$ZI[0],TYPE,TEMPR); 02703 M00S02703.sslabel +++| IF FLAG NQ 0 02704 M00S02704.sslabel +++| THEN # CONVERSION ERROR # 02705 M00S02705.sslabel +++| BEGIN 02706 M00S02706.sslabel +++| RETURN; 02707 M00S02707.sslabel +++| END 02708 M00S02708.sslabel +++| 02709 M00S02709.sslabel +++| LBARG$ZI[0] = TEMPR; # RESET *ZI* # 02710 M00S02710.sslabel +++| END 02711 M00S02711.sslabel +++| 02712 M00S02712.sslabel +++| ELSE 02713 M00S02713.sslabel +++| BEGIN 02714 M00S02714.sslabel +++| IF LBARG$ZI[0] EQ 0 02715 M00S02715.sslabel +++| THEN # *ZI* OMITTED # 02716 M00S02716.sslabel +++| BEGIN 02717 M00S02717.sslabel +++| LBARG$ZI[0] = -1; # SET DEFAULT VALUE # 02718 M00S02718.sslabel +++| END 02719 M00S02719.sslabel +++| 02720 M00S02720.sslabel +++| END 02721 M00S02721.sslabel +++| 02722 M00S02722.sslabel +++|# 02723 M00S02723.sslabel +++|* CHECK THE VALUE OF *ZF*. 02724 M00S02724.sslabel +++|# 02725 M00S02725.sslabel +++| 02726 M00S02726.sslabel +++| IF LBARG$ZF[0] NQ 0 AND LBARG$ZF[0] NQ O"7777" 02727 M00S02727.sslabel +++| THEN 02728 M00S02728.sslabel +++| BEGIN 02729 M00S02729.sslabel +++| FLAG = XDXB(LBARG$ZF[0],TYPE,TEMPR); 02730 M00S02730.sslabel +++| IF FLAG NQ 0 02731 M00S02731.sslabel +++| THEN # CONVERSION ERROR # 02732 M00S02732.sslabel +++| BEGIN 02733 M00S02733.sslabel +++| RETURN; 02734 M00S02734.sslabel +++| END 02735 M00S02735.sslabel +++| 02736 M00S02736.sslabel +++| LBARG$ZF[0] = TEMPR; # RESET *ZF* # 02737 M00S02737.sslabel +++| END 02738 M00S02738.sslabel +++| 02739 M00S02739.sslabel +++| ELSE 02740 M00S02740.sslabel +++| BEGIN 02741 M00S02741.sslabel +++| IF LBARG$ZF[0] EQ 0 02742 M00S02742.sslabel +++| THEN # *ZF* OMITTED # 02743 M00S02743.sslabel +++| BEGIN 02744 M00S02744.sslabel +++| LBARG$ZF[0] = -1; # SET DEFAULT VALUE # 02745 M00S02745.sslabel +++| END 02746 M00S02746.sslabel +++| 02747 M00S02747.sslabel +++| END 02748 M00S02748.sslabel +++| 02749 M00S02749.sslabel +++|# 02750 M00S02750.sslabel +++|* CHECK THE VALUE OF *SB*. 02751 M00S02751.sslabel +++|# 02752 M00S02752.sslabel +++| 02753 M00S02753.sslabel +++| IF LBARG$SB[0] NQ 0 02754 M00S02754.sslabel +++| THEN 02755 M00S02755.sslabel +++| BEGIN 02756 M00S02756.sslabel +++| FLAG = XDXB(LBARG$SB[0],TYPE,TEMPR); 02757 M00S02757.sslabel +++| IF FLAG NQ 0 02758 M00S02758.sslabel +++| THEN # CONVERSION ERROR # 02759 M00S02759.sslabel +++| BEGIN 02760 M00S02760.sslabel +++| RETURN; 02761 M00S02761.sslabel +++| END 02762 M00S02762.sslabel +++| 02763 M00S02763.sslabel +++| LBARG$SB[0] = TEMPR; # RESET *SB* # 02764 M00S02764.sslabel +++| END 02765 M00S02765.sslabel +++| 02766 M00S02766.sslabel +++|# 02767 M00S02767.sslabel +++|* CHECK *CN* AND *PK*. 02768 M00S02768.sslabel +++|# 02769 M00S02769.sslabel +++| 02770 M00S02770.sslabel +++| IF LBARG$C[0] EQ 0 AND LBARG$PK[0] EQ 0 02771 M00S02771.sslabel +++| THEN 02772 M00S02772.sslabel +++| BEGIN 02773 M00S02773.sslabel +++| LBARG$PK[0] = "P"; 02774 M00S02774.sslabel +++| END 02775 M00S02775.sslabel +++| 02776 M00S02776.sslabel +++|# 02777 M00S02777.sslabel +++|* CHECK *PT*. 02778 M00S02778.sslabel +++|# 02779 M00S02779.sslabel +++| 02780 M00S02780.sslabel +++| IF LBARG$PT[0] EQ 0 02781 M00S02781.sslabel +++| THEN 02782 M00S02782.sslabel +++| BEGIN 02783 M00S02783.sslabel +++| LBARG$PT[0] = "P"; 02784 M00S02784.sslabel +++| END 02785 M00S02785.sslabel +++| 02786 M00S02786.sslabel +++|# 02787 M00S02787.sslabel +++|* CHECK *SM*. 02788 M00S02788.sslabel +++|# 02789 M00S02789.sslabel +++| 02790 M00S02790.sslabel +++| IF LBARG$SM[0] EQ 0 02791 M00S02791.sslabel +++| THEN 02792 M00S02792.sslabel +++| BEGIN 02793 M00S02793.sslabel +++| LBARG$SM[0] = "A"; 02794 M00S02794.sslabel +++| END 02795 M00S02795.sslabel +++| 02796 M00S02796.sslabel +++| RETURN; 02797 M00S02797.sslabel +++| 02798 M00S02798.sslabel +++| END # LBCONV # 02799 M00S02799.sslabel +++| 02800 M00S02800.sslabel +++| TERM 02801 M00S02801.sslabel +++|PROC LBERR((ERR$CODE)); 02802 M00S02802.sslabel +++|# TITLE LBERR - *SSLABEL* ERROR PROCESSOR. # 02803 M00S02803.sslabel +++| 02804 M00S02804.sslabel +++| BEGIN # LBERR # 02805 M00S02805.sslabel +++| 02806 M00S02806.sslabel +++|# 02807 M00S02807.sslabel +++|** LBERR - *SSLABEL* ERROR PROCESSOR. 02808 M00S02808.sslabel +++|* 02809 M00S02809.sslabel +++|* THIS PROCEDURE DOES ERROR PROCESSING FOR *SSLABEL* IN 02810 M00S02810.sslabel +++|* ACCORDANCE WITH THE VALUE OF THE ERROR CODE. 02811 M00S02811.sslabel +++|* 02812 M00S02812.sslabel +++|* PROC LBERR((ERR$CODE)) 02813 M00S02813.sslabel +++|* 02814 M00S02814.sslabel +++|* ENTRY ERR$CODE = STATUS ITEM INDICATING THE ERROR CODE. 02815 M00S02815.sslabel +++|* 02816 M00S02816.sslabel +++|* EXIT ERROR PROCESSING IS COMPLETED. DEPENDING ON ERROR 02817 M00S02817.sslabel +++|* TYPE, EITHER A RETURN OR AN ABORT OCCURS. 02818 M00S02818.sslabel +++|* 02819 M00S02819.sslabel +++|* MESSAGES SEE ARRAY *ERRMSG* FOR THE 02820 M00S02820.sslabel +++|* DAYFILE MESSAGES. 02821 M00S02821.sslabel +++|* 02822 M00S02822.sslabel +++|* NOTES PROC *LBERR* IS A TABLE DRIVEN 02823 M00S02823.sslabel +++|* ERROR PROCESSOR. A TABLE HAS BEEN 02824 M00S02824.sslabel +++|* PRESET WITH THE ERROR MESSAGES FOR THE 02825 M00S02825.sslabel +++|* DIFFERENT ERROR CODES. THE ERROR CODE 02826 M00S02826.sslabel +++|* CORRESPONDS TO THE ORDINAL OF THE CORRE- 02827 M00S02827.sslabel +++|* SPONDING ENTRY IN THE TABLE. THE ACTION 02828 M00S02828.sslabel +++|* TO BE TAKEN ON EACH ERROR CONDITION IS 02829 M00S02829.sslabel +++|* PRESET AS STATUS VALUES INTO EACH ENTRY. 02830 M00S02830.sslabel +++|* USING THE ERROR CODE THE CORRESPONDING 02831 M00S02831.sslabel +++|* ENTRY IN THE TABLE IS FOUND AND THE ERROR 02832 M00S02832.sslabel +++|* CONDITION IS PROCESSED BY USING A STATUS 02833 M00S02833.sslabel +++|* SWITCH THAT CORRESPONDS TO THE STATUS 02834 M00S02834.sslabel +++|* VALUES PRESET IN THE ENTRY. THE MESSAGES 02835 M00S02835.sslabel +++|* ARE PRINTED OUT IN THE DAYFILE AND ALSO 02836 M00S02836.sslabel +++|* ON THE REPORT FILE IF ONE IS SPECIFIED. 02837 M00S02837.sslabel +++|# 02838 M00S02838.sslabel +++| 02839 M00S02839.sslabel +++| ITEM ERR$CODE U; # ERROR CODE # 02840 M00S02840.sslabel +++| 02841 M00S02841.sslabel +++|# 02842 M00S02842.sslabel +++|**** PROC LBERR - XREF LIST BEGIN. 02843 M00S02843.sslabel +++|# 02844 M00S02844.sslabel +++| 02845 M00S02845.sslabel +++| XREF 02846 M00S02846.sslabel +++| BEGIN 02847 M00S02847.sslabel +++| PROC MESSAGE; # WRITES USER DAYFILE MESSAGE # 02848 M00S02848.sslabel +++| PROC RESTPFP; # RESTORE USER-S *PFP* AND ABORT 02849 M00S02849.sslabel +++| OR RETURN # 02850 M00S02850.sslabel +++| PROC RPCLOSE; # CLOSES OUTPUT PRINT FILE # 02851 M00S02851.sslabel +++| PROC RPLINE; # WRITES PRINT LINE FOR REPORT # 02852 M00S02852.sslabel +++| PROC RPSPACE; # WRITES BLANK LINE ON REPORT # 02853 M00S02853.sslabel +++| FUNC XCDD C(10); # CONVERT ITEMS TO DISPLAY CODE # 02854 M00S02854.sslabel +++| END 02855 M00S02855.sslabel +++| 02856 M00S02856.sslabel +++|# 02857 M00S02857.sslabel +++|**** PROC LBERR - XREF LIST END. 02858 M00S02858.sslabel +++|# 02859 M00S02859.sslabel +++| 02860 M00S02860.sslabel +++| DEF PROCNAME #"LBERR."#; # PROC NAME # 02861 M00S02861.sslabel +++| 02862 M00S02862.sslabel +++| STATUS ACTION # ERROR PROCESSING TO BE DONE # 02863 M00S02863.sslabel +++| MSG, # DISPLAY ERROR MESSAGE # 02864 M00S02864.sslabel +++| MSGDETL, # DISPLAY DETAIL ERROR MESSAGE # 02865 M00S02865.sslabel +++| RETRN, # RETURN TO MAIN LOOP # 02866 M00S02866.sslabel +++| ABRT, # ABORT SSLABEL # 02867 M00S02867.sslabel +++| LSTACT; # END OF STATUS LIST # 02868 M00S02868.sslabel +++| 02869 M00S02869.sslabel +++| DEF LISTCON #0#; # DO NOT LIST THE COMDECKS # 02870 M00S02870.sslabel +++|*CALL COMBFAS 02871 M00S02871.sslabel +++|*CALL COMTERR 02872 M00S02872.sslabel +++|*CALL COMTLAB 02873 M00S02873.sslabel +++|*CALL COMTLBP 02874 M00S02874.sslabel +++|*CALL COMTOUT 02875 M00S02875.sslabel +++| 02876 M00S02876.sslabel +++| ITEM DIS$ASN C(20); # CUBES ASSIGNED (DISPLAY CODE) # 02877 M00S02877.sslabel +++| ITEM DIS$ERR C(20); # ERROR CODE (DISPLAY CODE) # 02878 M00S02878.sslabel +++| ITEM I I; # LOOP VARIABLE # 02879 M00S02879.sslabel +++| ITEM STAT U; # ERROR TABLE ENTRY STATUS # 02880 M00S02880.sslabel +++| 02881 M00S02881.sslabel +++|# 02882 M00S02882.sslabel +++|* THIS ARRAY IS FOR DISPLAYING DETAILED MESSAGES. 02883 M00S02883.sslabel +++|# 02884 M00S02884.sslabel +++| 02885 M00S02885.sslabel +++| ARRAY DETAIL [0:0] P(5); # FOR MESSAGES WITH DETAIL NO. # 02886 M00S02886.sslabel +++| BEGIN 02887 M00S02887.sslabel +++| ITEM DET$MSG1 C(00,00,40); # ERROR MESSAGE # 02888 M00S02888.sslabel +++| ITEM DET$NO C(02,00,05); # DETAIL NUMBER # 02889 M00S02889.sslabel +++| ITEM DET$PRD C(02,30,01); # PERIOD AT END OF MESSAGE # 02890 M00S02890.sslabel +++| ITEM DET$BLNK C(02,36,14); # BLANK FILL # 02891 M00S02891.sslabel +++| ITEM DET$ZRO U(04,00,60) = [0]; # ZERO BYTE TERMINATOR # 02892 M00S02892.sslabel +++| END 02893 M00S02893.sslabel +++| 02894 M00S02894.sslabel +++|# 02895 M00S02895.sslabel +++|* THIS ARRAY IS FOR DISPLAYING DIRECTIVE NUMBERS. 02896 M00S02896.sslabel +++|# 02897 M00S02897.sslabel +++| 02898 M00S02898.sslabel +++| ARRAY DIRECTV [0:0] P(2); 02899 M00S02899.sslabel +++| BEGIN 02900 M00S02900.sslabel +++| ITEM DIR$MSG C(00,00,11) = [" DIRECTIVE "]; 02901 M00S02901.sslabel +++| ITEM DIR$NO C(01,06,03); # DIRECTIVE NUMBER # 02902 M00S02902.sslabel +++| ITEM DIR$PRD C(01,24,01); # ENDING PERIOD # 02903 M00S02903.sslabel +++| ITEM DIRZRO U(01,30,30) = [0]; # ZERO BYTE # 02904 M00S02904.sslabel +++| END 02905 M00S02905.sslabel +++| 02906 M00S02906.sslabel +++|# 02907 M00S02907.sslabel +++|* ARRAY ERRMSG IS AN ERROR TABLE IN WHICH THE ORDINAL OF EACH 02908 M00S02908.sslabel +++|* ENTRY IS EQUAL TO THE ERROR CODE IT REPRESENTS. EACH ENTRY 02909 M00S02909.sslabel +++|* CONTAINS THE APPROPRIATE ERROR MESSAGE AND THE STATUS VALUES 02910 M00S02910.sslabel +++|* WHICH CONTROL ERROR PROCESSING. 02911 M00S02911.sslabel +++|# 02912 M00S02912.sslabel +++| 02913 M00S02913.sslabel +++| ARRAY ERRMSG [0:CODEMAX] S(6); 02914 M00S02914.sslabel +++| BEGIN 02915 M00S02915.sslabel +++| ITEM ERRMSSG C(00,00,40) = [ # MESSAGE ENTRY TO BE 02916 M00S02916.sslabel +++| DISPLAYED # 02917 M00S02917.sslabel +++| " CATALOG/MAP ATTACH PROBLEM.", 02918 M00S02918.sslabel +++| " SYNTAX ERROR IN DIRECTIVE.", 02919 M00S02919.sslabel +++| " SYNTAX ERROR - SSLABEL ABORT.", 02920 M00S02920.sslabel +++| " CSN NOT FOUND IN SMMAP.", 02921 M00S02921.sslabel +++| " NO EMPTY CUBE IN FAMILY/POOL.", 02922 M00S02922.sslabel +++| " NO CARTRIDGE AVAILABLE IN POOL.", 02923 M00S02923.sslabel +++| " NO EMPTY CARTRIDGES AVAILABLE IN FAMILY.", 02924 M00S02924.sslabel +++| " NO MANUFACTURER OR SCRATCH LABEL.", 02925 M00S02925.sslabel +++| " UNEXPECTED SM, Y, Z, FAMILY OR SUBFAM.", 02926 M00S02926.sslabel +++| " CANNOT FIX CSN FOR GOOD LABEL.", 02927 M00S02927.sslabel +++| " UNRECOVERABLE READ ERROR.", 02928 M00S02928.sslabel +++| " UNRECOVERABLE WRITE ERROR.", 02929 M00S02929.sslabel +++| " EXCESSIVE PARITY ERRORS.", 02930 M00S02930.sslabel +++| " CSN ALREADY IN SMMAP.", 02931 M00S02931.sslabel +++| " CARTRIDGE ALREADY IN CUBE.", 02932 M00S02932.sslabel +++| " CARTRIDGE LABEL ERROR.", 02933 M00S02933.sslabel +++| " CARTRIDGE ALREADY IN USE.", 02934 M00S02934.sslabel +++| " STORAGE MODULE IS TURNED OFF.", 02935 M00S02935.sslabel +++| " CARTRIDGE NOT FOUND.", 02936 M00S02936.sslabel +++| " CARTRIDGE NOT EMPTY.", 02937 M00S02937.sslabel +++| " M860 HARDWARE PROBLEM.", 02938 M00S02938.sslabel +++| " CATALOG/MAP FILE INTERLOCKED.", 02939 M00S02939.sslabel +++| " NO SUCH SMMAP OR SUBCATALOG.", 02940 M00S02940.sslabel +++| " CATALOG/MAP NOT OPEN.", 02941 M00S02941.sslabel +++| " CATALOG LOST BIT MUST BE SET.", 02942 M00S02942.sslabel +++| " CARTRIDGE PRESENT--LOST BIT SET.", 02943 M00S02943.sslabel +++| " SUB ALREADY DEFINED.", 02944 M00S02944.sslabel +++| " CUBES ASSIGNED TO SUB-FAMILY.", 02945 M00S02945.sslabel +++| " INSUFFICIENT CUBES.", 02946 M00S02946.sslabel +++| " SELECTED CUBE NOT UNASSIGNED.", 02947 M00S02947.sslabel +++| " NO EMPTY CUBES.", 02948 M00S02948.sslabel +++| " SELECTED CUBE NOT EMPTY.", 02949 M00S02949.sslabel +++| " SELECTED CUBE NOT ASSIGNED AS EXPECTED.", 02950 M00S02950.sslabel +++| " CARTRIDGE NOT ASSIGNED AS EXPECTED.", 02951 M00S02951.sslabel +++| " UNRECOGNIZABLE LABEL.", 02952 M00S02952.sslabel +++| " NO MATCH ON FAMILY/SUBFAMILY.", 02953 M00S02953.sslabel +++| " INCORRECT CSN.", 02954 M00S02954.sslabel +++| " ADDCUBE - ONLY 100 LOCATIONS PROCESSED.", 02955 M00S02955.sslabel +++| " INCORRECT N.", 02956 M00S02956.sslabel +++| " CSN OPTION VIOLATED.", 02957 M00S02957.sslabel +++| " PK,PT OPTION VIOLATED.", 02958 M00S02958.sslabel +++| " LT OPTION NOT SPECIFIED CORRECTLY.", 02959 M00S02959.sslabel +++| " INCORRECT SM NUMBER.", 02960 M00S02960.sslabel +++| " Y,Z OPTION VIOLATED.", 02961 M00S02961.sslabel +++| " INCORRECT SUBFAMILY.", 02962 M00S02962.sslabel +++| " ON,OF NOT SPECIFIED CORRECTLY.", 02963 M00S02963.sslabel +++| " INCORRECT DIRECTIVE.", 02964 M00S02964.sslabel +++| " GR PARAMETER USED INCORRECTLY.", 02965 M00S02965.sslabel +++| " GR PARAMETER OUT OF RANGE.", 02966 M00S02966.sslabel +++| " B PARAMETER USED INCORRECTLY.", 02967 M00S02967.sslabel +++| " B PARAMETER OUT OF RANGE.", 02968 M00S02968.sslabel +++| " NO EMPTY CARTRIDGES IN GROUP." ]; 02969 M00S02969.sslabel +++| ITEM ERRZERO U(04,00,60) = [0, 02970 M00S02970.sslabel +++| CODEMAX(0)]; 02971 M00S02971.sslabel +++| ITEM ERRSTATW U(05,00,60); # PROCESSING TO BE DONE # 02972 M00S02972.sslabel +++| 02973 M00S02973.sslabel +++|# 02974 M00S02974.sslabel +++|* TYPE OF MESSAGE TO BE PRINTED. 02975 M00S02975.sslabel +++|# 02976 M00S02976.sslabel +++| 02977 M00S02977.sslabel +++| ITEM ERRSTAT1 S:ACTION (05,00,06) = [ 4(S"MSG"), 02978 M00S02978.sslabel +++| 3(S"MSGDETL"), 02979 M00S02979.sslabel +++| 11(S"MSG"), 02980 M00S02980.sslabel +++| 1(S"MSGDETL"), 02981 M00S02981.sslabel +++| 9(S"MSG"), 02982 M00S02982.sslabel +++| 5(S"MSGDETL"), 02983 M00S02983.sslabel +++| 15(S"MSG"), 02984 M00S02984.sslabel +++| 5(S"MSGDETL") ]; 02985 M00S02985.sslabel +++| 02986 M00S02986.sslabel +++|# 02987 M00S02987.sslabel +++|* ACTION TO BE TAKEN AFTER PRINTING MESSAGE. 02988 M00S02988.sslabel +++|# 02989 M00S02989.sslabel +++| 02990 M00S02990.sslabel +++| ITEM ERRSTAT2 S:ACTION (05,06,06) = [ S"ABRT", 02991 M00S02991.sslabel +++| S"RETRN", 02992 M00S02992.sslabel +++| 35(S"ABRT"), 02993 M00S02993.sslabel +++| 15(S"RETRN"), 02994 M00S02994.sslabel +++| 1(S"ABRT") ]; 02995 M00S02995.sslabel +++| END 02996 M00S02996.sslabel +++| 02997 M00S02997.sslabel +++|# 02998 M00S02998.sslabel +++|* ARRAY TO PRINT DAYFILE MESSAGE. 02999 M00S02999.sslabel +++|# 03000 M00S03000.sslabel +++| 03001 M00S03001.sslabel +++| ARRAY MSGBUF [0:0] P(3); 03002 M00S03002.sslabel +++| BEGIN 03003 M00S03003.sslabel +++| ITEM MSG$ID C(00,00,15) = [" SSLABEL ERROR "]; 03004 M00S03004.sslabel +++| ITEM MSG$NO C(01,30,03); # ERROR NUMBER DISPLAYED # 03005 M00S03005.sslabel +++| ITEM MSGPRD C(01,48,01) = ["."]; 03006 M00S03006.sslabel +++| ITEM MSGZERO U(02,48,12) = [0]; # ZERO BYTE TERMINATOR # 03007 M00S03007.sslabel +++| END 03008 M00S03008.sslabel +++| 03009 M00S03009.sslabel +++| SWITCH ACT: ACTION # TYPE OF ERROR PROCESSING # 03010 M00S03010.sslabel +++| REPORT: MSG, # DISPLAY ERROR MESSAGE # 03011 M00S03011.sslabel +++| DETL$RPT: MSGDETL, # DISPLAY DETAIL ERROR MESSAGE # 03012 M00S03012.sslabel +++| RTURN: RETRN, # RETURN TO MAIN LOOP # 03013 M00S03013.sslabel +++| ABT: ABRT; # ABORT *SSLABEL* # 03014 M00S03014.sslabel +++| 03015 M00S03015.sslabel +++| CONTROL EJECT; 03016 M00S03016.sslabel +++| 03017 M00S03017.sslabel +++|# 03018 M00S03018.sslabel +++|* CHECK FOR LEGAL ERROR CODE. 03019 M00S03019.sslabel +++|# 03020 M00S03020.sslabel +++| 03021 M00S03021.sslabel +++| IF ERR$CODE LS 0 OR ERR$CODE GR CODEMAX 03022 M00S03022.sslabel +++| THEN # ERROR CODE OUT OF RANGE # 03023 M00S03023.sslabel +++| BEGIN 03024 M00S03024.sslabel +++| LBMSG$PROC[0] = PROCNAME; 03025 M00S03025.sslabel +++| MESSAGE(LBMSG[0],SYSUDF1); 03026 M00S03026.sslabel +++| RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT # 03027 M00S03027.sslabel +++| END 03028 M00S03028.sslabel +++| 03029 M00S03029.sslabel +++| DIR$NO[0] = LBARG$DIRN[0]; 03030 M00S03030.sslabel +++| DIR$PRD = "."; 03031 M00S03031.sslabel +++| DIS$ERR = XCDD(ERR$CODE); 03032 M00S03032.sslabel +++| MSG$NO[0] = C<7,3>DIS$ERR; 03033 M00S03033.sslabel +++| 03034 M00S03034.sslabel +++|# 03035 M00S03035.sslabel +++|* BEAD OUT STATUS VALUES FROM ERROR CODE ENTRY, AND DO 03036 M00S03036.sslabel +++|* CORRESPONDING PROCESSING. 03037 M00S03037.sslabel +++|# 03038 M00S03038.sslabel +++| 03039 M00S03039.sslabel +++| SLOWFOR I = 0 STEP 6 UNTIL 12 03040 M00S03040.sslabel +++| DO 03041 M00S03041.sslabel +++| BEGIN 03042 M00S03042.sslabel +++| STAT = B<I,6>ERRSTATW[ERR$CODE]; 03043 M00S03043.sslabel +++| GOTO ACT[STAT]; 03044 M00S03044.sslabel +++| 03045 M00S03045.sslabel +++|REPORT: # REPORT THE ERROR # 03046 M00S03046.sslabel +++| MESSAGE(ERRMSG[ERR$CODE],SYSUDF1); 03047 M00S03047.sslabel +++| IF ERR$CODE NQ ERRLIST"SYNTX$ABRT" 03048 M00S03048.sslabel +++| THEN 03049 M00S03049.sslabel +++| BEGIN 03050 M00S03050.sslabel +++| MESSAGE(MSGBUF[0],UDFL1); 03051 M00S03051.sslabel +++| MESSAGE(DIRECTV[0],UDFL1); 03052 M00S03052.sslabel +++| RPLINE(OUT$FETP,"*** ERROR",2,9,1); 03053 M00S03053.sslabel +++| RPLINE(OUT$FETP,MSG$NO[0],12,3,1); 03054 M00S03054.sslabel +++| RPLINE(OUT$FETP,"DIRECTIVE",19,9,1); 03055 M00S03055.sslabel +++| RPLINE(OUT$FETP,DIR$NO[0],29,3,0); 03056 M00S03056.sslabel +++| RPLINE(OUT$FETP,ERRMSSG[ERR$CODE],18,40,1); 03057 M00S03057.sslabel +++| RPLINE(OUT$FETP,"***",58,3,0); 03058 M00S03058.sslabel +++| RPSPACE(OUT$FETP,SP"SPACE",1); 03059 M00S03059.sslabel +++| END 03060 M00S03060.sslabel +++| 03061 M00S03061.sslabel +++| TEST I; 03062 M00S03062.sslabel +++| 03063 M00S03063.sslabel +++|DETL$RPT: # REPORT THE ERROR IN DETAIL # 03064 M00S03064.sslabel +++| DIS$ASN = XCDD(NUMDONE); 03065 M00S03065.sslabel +++| DET$MSG1[0] = ERRMSSG[ERR$CODE]; 03066 M00S03066.sslabel +++| MESSAGE(MSGBUF[0],UDFL1); 03067 M00S03067.sslabel +++| MESSAGE(DIRECTV[0],UDFL1); 03068 M00S03068.sslabel +++| MESSAGE(DETAIL[0],SYSUDF1); 03069 M00S03069.sslabel +++| DET$MSG1[0] = " NUMBER PROCESSED = "; 03070 M00S03070.sslabel +++| DET$BLNK[0] = " "; 03071 M00S03071.sslabel +++| DET$NO[0] = C<5,5>DIS$ASN; 03072 M00S03072.sslabel +++| DET$PRD[0] = "."; # ADD PERIOD TO END OF MESSAGE # 03073 M00S03073.sslabel +++| MESSAGE(DETAIL,SYSUDF1); 03074 M00S03074.sslabel +++| RPLINE(OUT$FETP,"*** ERROR",2,9,1); 03075 M00S03075.sslabel +++| RPLINE(OUT$FETP,MSG$NO[0],12,3,1); 03076 M00S03076.sslabel +++| RPLINE(OUT$FETP,"DIRECTIVE",19,9,1); 03077 M00S03077.sslabel +++| RPLINE(OUT$FETP,DIR$NO[0],29,3,0); 03078 M00S03078.sslabel +++| RPLINE(OUT$FETP,ERRMSSG[ERR$CODE],18,40,0); 03079 M00S03079.sslabel +++| RPLINE(OUT$FETP,"NUMBER PROCESSED = ",19,19,1); 03080 M00S03080.sslabel +++| RPLINE(OUT$FETP,DET$NO[0],38,5,1); 03081 M00S03081.sslabel +++| RPLINE(OUT$FETP,"***",45,3,0); 03082 M00S03082.sslabel +++| RPSPACE(OUT$FETP,SP"SPACE",1); 03083 M00S03083.sslabel +++| TEST I; 03084 M00S03084.sslabel +++| 03085 M00S03085.sslabel +++|RTURN: # RETURN TO CALLING PROC # 03086 M00S03086.sslabel +++| RETURN; 03087 M00S03087.sslabel +++| 03088 M00S03088.sslabel +++|ABT: # ABORT PROCESSING # 03089 M00S03089.sslabel +++| RPCLOSE(OUT$FETP); 03090 M00S03090.sslabel +++| RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT # 03091 M00S03091.sslabel +++| END 03092 M00S03092.sslabel +++| 03093 M00S03093.sslabel +++| END # LBERR # 03094 M00S03094.sslabel +++| 03095 M00S03095.sslabel +++| TERM 03096 M00S03096.sslabel +++|PROC LBFLMSC; 03097 M00S03097.sslabel +++|# TITLE LBFLMSC - MODIFIES THE *INHIBIT* FLAG IN THE FCT. # 03098 M00S03098.sslabel +++| 03099 M00S03099.sslabel +++| BEGIN # LBFLMSC # 03100 M00S03100.sslabel +++| 03101 M00S03101.sslabel +++|# 03102 M00S03102.sslabel +++|** LBFLMSC - MODIFIES THE *INHIBIT* FLAG IN THE FCT. 03103 M00S03103.sslabel +++|* 03104 M00S03104.sslabel +++|* THIS PROC UPDATES THE *INHIBIT* FLAG IN THE FCT ENTRY 03105 M00S03105.sslabel +++|* CORRESPONDING TO THE CSN SPECIFIED. 03106 M00S03106.sslabel +++|* 03107 M00S03107.sslabel +++|* PROC LBFLMSC. 03108 M00S03108.sslabel +++|* 03109 M00S03109.sslabel +++|* ENTRY CRACKED AND SYNTAX CHECKED DIRECTIVE 03110 M00S03110.sslabel +++|* PARAMETERS SET UP IN COMMON AREA DEFINED 03111 M00S03111.sslabel +++|* IN *COMTLBP*. 03112 M00S03112.sslabel +++|* 03113 M00S03113.sslabel +++|* EXIT *INHIBIT* FLAG UPDATED OR ERROR CONDITION. 03114 M00S03114.sslabel +++|* 03115 M00S03115.sslabel +++|* NOTES PROC *LBFLMSC* SEARCHES THE SMMAP FOR AN ENTRY 03116 M00S03116.sslabel +++|* WITH A CSN MATCHING THAT SPECIFIED. IF THIS IS 03117 M00S03117.sslabel +++|* FOUND AND IT IS ASSIGNED TO A FAMILY, THEN THE 03118 M00S03118.sslabel +++|* *INHIBIT* FLAG IN THE CORRESPONDING *FCT* ENTRY 03119 M00S03119.sslabel +++|* OR THE FREE CARTRIDGE FLAG IN THE *FCT* IS 03120 M00S03120.sslabel +++|* MODIFIED. IF *ON* IS SPECIFIED THE FLAG IS SET, 03121 M00S03121.sslabel +++|* AND IF *OFF* IS SPECIFIED THE FLAG IS CLEARED. 03122 M00S03122.sslabel +++|# 03123 M00S03123.sslabel +++| 03124 M00S03124.sslabel +++|# 03125 M00S03125.sslabel +++|**** PROC LBFLMSC - XREF LIST BEGIN. 03126 M00S03126.sslabel +++|# 03127 M00S03127.sslabel +++| 03128 M00S03128.sslabel +++| XREF 03129 M00S03129.sslabel +++| BEGIN 03130 M00S03130.sslabel +++| PROC CALL3; # ISSUES TYPE 3 CALLSS TO EXEC # 03131 M00S03131.sslabel +++| PROC LBERR; # *SSLABEL* ERROR PROCESSOR # 03132 M00S03132.sslabel +++| PROC LBRESP; # RESPONSE CODE PROCESSOR # 03133 M00S03133.sslabel +++| PROC SERCSU; # SEARCHES THE SMMAP # 03134 M00S03134.sslabel +++| END 03135 M00S03135.sslabel +++| 03136 M00S03136.sslabel +++|# 03137 M00S03137.sslabel +++|**** PROC LBFLMSC - XREF LIST END. 03138 M00S03138.sslabel +++|# 03139 M00S03139.sslabel +++| 03140 M00S03140.sslabel +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS # 03141 M00S03141.sslabel +++|*CALL COMBFAS 03142 M00S03142.sslabel +++|*CALL COMBCPR 03143 M00S03143.sslabel +++|*CALL COMBMAP 03144 M00S03144.sslabel +++|*CALL COMTERR 03145 M00S03145.sslabel +++|*CALL COMTLAB 03146 M00S03146.sslabel +++|*CALL COMTLBP 03147 M00S03147.sslabel +++| 03148 M00S03148.sslabel +++| ITEM CATFLD U; # CATALOG FIELD # 03149 M00S03149.sslabel +++| ITEM CATVALUE I; # CATALOG VALUE # 03150 M00S03150.sslabel +++| ITEM FLAG I; # ERROR FLAG # 03151 M00S03151.sslabel +++| ITEM REQCODE U; # REQUEST CODE # 03152 M00S03152.sslabel +++| ITEM RESP$CODE U; # RESPONSE CODE FROM EXEC # 03153 M00S03153.sslabel +++| ITEM SERTYPE S:SERCH$TYPE; # SEARCH TYPE # 03154 M00S03154.sslabel +++| ITEM SP$VSN C(12); # SPECIFIED CSN # 03155 M00S03155.sslabel +++| 03156 M00S03156.sslabel +++| 03157 M00S03157.sslabel +++| ARRAY PT$CSU$ENT [0:0] P(5); # *PUT* SMMAP ENTRY # 03158 M00S03158.sslabel +++| BEGIN 03159 M00S03159.sslabel +++| ITEM PT$MAPENT C(00,00,30); # THREE WORD MAP ENTRY # 03160 M00S03160.sslabel +++| ITEM PT$Y U(03,00,30); # Y COORDINATE # 03161 M00S03161.sslabel +++| ITEM PT$Z U(03,30,30); # Z COORDINATE # 03162 M00S03162.sslabel +++| ITEM PT$GR U(04,00,07); # GROUP # 03163 M00S03163.sslabel +++| ITEM PT$GRT U(04,07,04); # GROUP ORDINAL # 03164 M00S03164.sslabel +++| END 03165 M00S03165.sslabel +++| 03166 M00S03166.sslabel +++| 03167 M00S03167.sslabel +++| CONTROL EJECT; 03168 M00S03168.sslabel +++| 03169 M00S03169.sslabel +++| SERTYPE = S"CSN$MATCH"; 03170 M00S03170.sslabel +++| SP$VSN = LBARG$C[0]; 03171 M00S03171.sslabel +++| 03172 M00S03172.sslabel +++|# 03173 M00S03173.sslabel +++|* SEARCH FOR MATCHING VSN. 03174 M00S03174.sslabel +++|# 03175 M00S03175.sslabel +++| 03176 M00S03176.sslabel +++| SERCSU(SERTYPE,0,0,0,SP$VSN,0,0,PT$CSU$ENT[0],FLAG); 03177 M00S03177.sslabel +++| IF FLAG NQ 0 03178 M00S03178.sslabel +++| THEN # VSN NOT FOUND # 03179 M00S03179.sslabel +++| BEGIN 03180 M00S03180.sslabel +++| ERRCODE = S"CSN$NOTFND"; 03181 M00S03181.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING # 03182 M00S03182.sslabel +++| RETURN; 03183 M00S03183.sslabel +++| END 03184 M00S03184.sslabel +++| 03185 M00S03185.sslabel +++|# 03186 M00S03186.sslabel +++|* CHECK CARTRIDGE ASSIGNMENT. 03187 M00S03187.sslabel +++|# 03188 M00S03188.sslabel +++| 03189 M00S03189.sslabel +++| P<SMUMAP> = LOC(PT$CSU$ENT[0]); 03190 M00S03190.sslabel +++| IF CM$CODE NQ CUBSTAT"SUBFAM" 03191 M00S03191.sslabel +++| THEN # NOT ASSIGNED TO FAMILY # 03192 M00S03192.sslabel +++| BEGIN 03193 M00S03193.sslabel +++| ERRCODE = S"UNX$CR$ASN"; 03194 M00S03194.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING # 03195 M00S03195.sslabel +++| RETURN; 03196 M00S03196.sslabel +++| END 03197 M00S03197.sslabel +++| 03198 M00S03198.sslabel +++|# 03199 M00S03199.sslabel +++|* ISSUE A REQUEST TO EXEC TO UPDATE THE CATALOG *INHIBIT* FLAG. 03200 M00S03200.sslabel +++|# 03201 M00S03201.sslabel +++| 03202 M00S03202.sslabel +++| IF LBARG$ON[0] NQ 0 03203 M00S03203.sslabel +++| THEN # *ON* SPECIFIED # 03204 M00S03204.sslabel +++| BEGIN 03205 M00S03205.sslabel +++| CATVALUE = 1; 03206 M00S03206.sslabel +++| END 03207 M00S03207.sslabel +++| 03208 M00S03208.sslabel +++| ELSE 03209 M00S03209.sslabel +++| BEGIN 03210 M00S03210.sslabel +++| IF LBARG$OF[0] NQ 0 03211 M00S03211.sslabel +++| THEN # *OFF* SPECIFIED # 03212 M00S03212.sslabel +++| BEGIN 03213 M00S03213.sslabel +++| CATVALUE = 0; 03214 M00S03214.sslabel +++| END 03215 M00S03215.sslabel +++| 03216 M00S03216.sslabel +++| END 03217 M00S03217.sslabel +++| 03218 M00S03218.sslabel +++| REQCODE = REQTYP3"UPD$CAT"; 03219 M00S03219.sslabel +++| IF LBARG$OP[0] EQ "FC" 03220 M00S03220.sslabel +++| THEN # FREE CARTRIDGE # 03221 M00S03221.sslabel +++| BEGIN 03222 M00S03222.sslabel +++| CATFLD = UCF"FREEFL"; 03223 M00S03223.sslabel +++| END 03224 M00S03224.sslabel +++| 03225 M00S03225.sslabel +++| ELSE # INHIBIT ALLOCATION # 03226 M00S03226.sslabel +++| BEGIN 03227 M00S03227.sslabel +++| CATFLD = UCF"INHIB"; 03228 M00S03228.sslabel +++| END 03229 M00S03229.sslabel +++| 03230 M00S03230.sslabel +++| 03231 M00S03231.sslabel +++|# 03232 M00S03232.sslabel +++|* UPDATE CATALOG. 03233 M00S03233.sslabel +++|# 03234 M00S03234.sslabel +++| 03235 M00S03235.sslabel +++| CALL3(REQCODE,PT$CSU$ENT[0],CATFLD,CATVALUE,RESP$CODE); 03236 M00S03236.sslabel +++| IF RESP$CODE NQ RESPTYP3"OK3" 03237 M00S03237.sslabel +++| THEN # UPDATE UNSUCCESSFUL # 03238 M00S03238.sslabel +++| BEGIN 03239 M00S03239.sslabel +++| LBRESP(RESP$CODE,TYP"TYP3"); 03240 M00S03240.sslabel +++| END 03241 M00S03241.sslabel +++| 03242 M00S03242.sslabel +++| RETURN; 03243 M00S03243.sslabel +++| 03244 M00S03244.sslabel +++| END # LBFLMSC # 03245 M00S03245.sslabel +++| 03246 M00S03246.sslabel +++| TERM 03247 M00S03247.sslabel +++|PROC LBFXVSN; 03248 M00S03248.sslabel +++|# TITLE LBFXVSN - REPLACES LABEL WITH SCRATCH LABEL. # 03249 M00S03249.sslabel +++| 03250 M00S03250.sslabel +++| BEGIN # LBFXVSN # 03251 M00S03251.sslabel +++| 03252 M00S03252.sslabel +++|# 03253 M00S03253.sslabel +++|** LBFXVSN - REPLACES LABEL WITH A SCRATCH LABEL. 03254 M00S03254.sslabel +++|* 03255 M00S03255.sslabel +++|* THIS PROC GETS A CARTRIDGE FROM THE INPUT DRAWER, WRITES A 03256 M00S03256.sslabel +++|* SCRATCH LABEL ON IT, AND ADDS IT TO THE POOL. 03257 M00S03257.sslabel +++|* 03258 M00S03258.sslabel +++|* PROC LBFXVSN. 03259 M00S03259.sslabel +++|* 03260 M00S03260.sslabel +++|* ENTRY CRACKED AND SYNTAX CHECKED DIRECTIVE 03261 M00S03261.sslabel +++|* PARAMETERS SET UP IN COMMON AREA DEFINED 03262 M00S03262.sslabel +++|* IN *COMTLBP*. 03263 M00S03263.sslabel +++|* 03264 M00S03264.sslabel +++|* EXIT CARTRIDGE IN SCRATCH POOL OR ERROR CONDITION. 03265 M00S03265.sslabel +++|* 03266 M00S03266.sslabel +++|* NOTES PROC *LBFXVSN* VERIFIES THE PRESENCE OF A CARTRIDGE 03267 M00S03267.sslabel +++|* IN THE INPUT DRAWER, AND SEARCHES FOR AN 03268 M00S03268.sslabel +++|* EMPTY CUBE IN THE POOL. EXEC IS CALLED TO BRING 03269 M00S03269.sslabel +++|* THE CARTRIDGE TO A DRIVE AND READ ITS LABEL. IF 03270 M00S03270.sslabel +++|* THE LABEL TYPE AGREES WITH THAT SPECIFIED, A NEW 03271 M00S03271.sslabel +++|* SCRATCH LABEL IS WRITTEN AND THE CARTRIDGE IS ADDED 03272 M00S03272.sslabel +++|* TO THE POOL. 03273 M00S03273.sslabel +++|# 03274 M00S03274.sslabel +++| 03275 M00S03275.sslabel +++|# 03276 M00S03276.sslabel +++|**** PROC LBFXVSN - XREF LIST BEGIN. 03277 M00S03277.sslabel +++|# 03278 M00S03278.sslabel +++| 03279 M00S03279.sslabel +++| XREF 03280 M00S03280.sslabel +++| BEGIN 03281 M00S03281.sslabel +++| PROC CALL3; # ISSUES TYPE 3 CALLSS TO EXEC # 03282 M00S03282.sslabel +++| PROC CALL4; # ISSUES TYPE 4 CALLSS TO EXEC # 03283 M00S03283.sslabel +++| PROC CKLAB; # CHECKS CARTRIDGE LABEL TYPE # 03284 M00S03284.sslabel +++| PROC CONVSN; # CONVERTS VSN FROM EBCDIC TO 03285 M00S03285.sslabel +++| DISPLAY CODE # 03286 M00S03286.sslabel +++| PROC DCEBC; # CONVERTS DISPLAY TO EBCDIC # 03287 M00S03287.sslabel +++| PROC DLABFLD; # DISPLAY LABEL FIELDS # 03288 M00S03288.sslabel +++| PROC GENLAB; # GENERATES A NEW LABEL # 03289 M00S03289.sslabel +++| PROC LBERR; # *SSLABEL* ERROR PROCESSOR # 03290 M00S03290.sslabel +++| PROC LBRESP; # RESPONSE CODE PROCESSOR # 03291 M00S03291.sslabel +++| PROC SERCSU; # SEARCHES THE SMMAP # 03292 M00S03292.sslabel +++| END 03293 M00S03293.sslabel +++| 03294 M00S03294.sslabel +++|# 03295 M00S03295.sslabel +++|**** PROC LBFXVSN - XREF LIST END. 03296 M00S03296.sslabel +++|# 03297 M00S03297.sslabel +++| 03298 M00S03298.sslabel +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS # 03299 M00S03299.sslabel +++|*CALL COMBFAS 03300 M00S03300.sslabel +++|*CALL COMBCPR 03301 M00S03301.sslabel +++|*CALL COMBLBL 03302 M00S03302.sslabel +++|*CALL COMBMAP 03303 M00S03303.sslabel +++|*CALL COMTERR 03304 M00S03304.sslabel +++|*CALL COMTLAB 03305 M00S03305.sslabel +++|*CALL COMTLBP 03306 M00S03306.sslabel +++| 03307 M00S03307.sslabel +++| ITEM CART$CSN C(20); # CARTRIDGE SERIAL NUMBER # 03308 M00S03308.sslabel +++| ITEM CONFLAG B; # CONVERSION FLAG # 03309 M00S03309.sslabel +++| ITEM DC$VSN C(8); # *CSN* IN DISPLAY CODE # 03310 M00S03310.sslabel +++| ITEM ERR$CNT I; # ERROR COUNT # 03311 M00S03311.sslabel +++| ITEM FLAG I; # ERROR FLAG # 03312 M00S03312.sslabel +++| ITEM HR$ERR I; # HARD READ ERRORS # 03313 M00S03313.sslabel +++| ITEM I I; # LOOP VARIABLE # 03314 M00S03314.sslabel +++| ITEM LAB$TYPE S:LABTYPE; # LABEL TYPE # 03315 M00S03315.sslabel +++| ITEM LD$CNT I; # LOAD COUNT # 03316 M00S03316.sslabel +++| ITEM LD$ERR I; # LOAD ERRORS # 03317 M00S03317.sslabel +++| ITEM PS$CNT I; # PASS COUNT # 03318 M00S03318.sslabel +++| ITEM REQCODE I; # REQUEST CODE # 03319 M00S03319.sslabel +++| ITEM RESP$CODE I; # RESPONSE CODE # 03320 M00S03320.sslabel +++| ITEM SERTYPE S:SERCH$TYPE; # SEARCH TYPE # 03321 M00S03321.sslabel +++| ITEM SP$CODE I; # SPECIFIED CODE # 03322 M00S03322.sslabel +++| ITEM SP$FAM C(7); # SPECIFIED FAMILY # 03323 M00S03323.sslabel +++| ITEM SP$SUB I; # SUBFAMILY # 03324 M00S03324.sslabel +++| ITEM SP$VSN C(8); # SPECIFIED CARTRIDGE *CSND* # 03325 M00S03325.sslabel +++| ITEM SP$Y I; # SPECIFIED Y COORDINATE # 03326 M00S03326.sslabel +++| ITEM SP$Z I; # SPECIFIED Z COORDINATE # 03327 M00S03327.sslabel +++| ITEM SR$ERR I; # SOFT READ ERRORS # 03328 M00S03328.sslabel +++| ITEM STR$RD I; # STRIPES READ # 03329 M00S03329.sslabel +++| ITEM STR$WR I; # STRIPES WRITTEN # 03330 M00S03330.sslabel +++| ITEM STR$DM I; # STRIPES DEMARKED # 03331 M00S03331.sslabel +++| ITEM SW$ERR I; # SOFT WRITE ERRORS # 03332 M00S03332.sslabel +++| ITEM TEMP$VSN C(8); # TEMPORARY *CSN* # 03333 M00S03333.sslabel +++| 03334 M00S03334.sslabel +++| 03335 M00S03335.sslabel +++| ARRAY PT$CSU$ENT [0:0] P(5); # *PUT* SMMAP ENTRY # 03336 M00S03336.sslabel +++| BEGIN 03337 M00S03337.sslabel +++| ITEM PT$MAPENT C(00,00,30); # THREE WORD MAP ENTRY # 03338 M00S03338.sslabel +++| ITEM PT$Y U(03,00,30); # Y COORDINATE # 03339 M00S03339.sslabel +++| ITEM PT$Z U(03,30,30); # Z COORDINATE # 03340 M00S03340.sslabel +++| ITEM PT$GR U(04,00,07); # GROUP # 03341 M00S03341.sslabel +++| ITEM PT$GRT U(04,07,04); # GROUP ORDINAL # 03342 M00S03342.sslabel +++| END 03343 M00S03343.sslabel +++| 03344 M00S03344.sslabel +++| 03345 M00S03345.sslabel +++| CONTROL EJECT; 03346 M00S03346.sslabel +++| 03347 M00S03347.sslabel +++|# 03348 M00S03348.sslabel +++|* CHECK IF SPECIFIED *CSN* IS ALREADY IN MAP. 03349 M00S03349.sslabel +++|# 03350 M00S03350.sslabel +++| 03351 M00S03351.sslabel +++| SERTYPE = S"CSN$MATCH"; # SEARCH FOR *CSN* # 03352 M00S03352.sslabel +++| SERCSU(SERTYPE,0,0,0,LBARG$C[0],0,0,PT$CSU$ENT[0],FLAG); 03353 M00S03353.sslabel +++| IF FLAG EQ 0 # *CSN* ALREADY IN MAP # 03354 M00S03354.sslabel +++| THEN 03355 M00S03355.sslabel +++| BEGIN 03356 M00S03356.sslabel +++| ERRCODE = S"DUPL$CSN"; 03357 M00S03357.sslabel +++| LBERR(ERRCODE); 03358 M00S03358.sslabel +++| RETURN; 03359 M00S03359.sslabel +++| END 03360 M00S03360.sslabel +++| 03361 M00S03361.sslabel +++| 03362 M00S03362.sslabel +++|# 03363 M00S03363.sslabel +++|* CHECK THAT CARTRIDGE IS PRESENT IN INPUT DRAWER AND SEARCH 03364 M00S03364.sslabel +++|* SMMAP FOR EMPTY CUBE IN THE POOL. 03365 M00S03365.sslabel +++|# 03366 M00S03366.sslabel +++| 03367 M00S03367.sslabel +++| SERTYPE = S"ASSIGN"; 03368 M00S03368.sslabel +++| SP$CODE = CUBSTAT"SCRPOOL"; 03369 M00S03369.sslabel +++| SP$FAM = " "; 03370 M00S03370.sslabel +++| SP$SUB = 0; 03371 M00S03371.sslabel +++| SP$VSN = " "; 03372 M00S03372.sslabel +++| SERCSU(SERTYPE,0,0,SP$CODE,SP$VSN,SP$FAM,SP$SUB,PT$CSU$ENT[0], 03373 M00S03373.sslabel +++| FLAG); 03374 M00S03374.sslabel +++| IF FLAG NQ 0 03375 M00S03375.sslabel +++| THEN # NO EMPTY CUBE IN POOL # 03376 M00S03376.sslabel +++| BEGIN 03377 M00S03377.sslabel +++| ERRCODE = S"NO$EMPCBFP"; 03378 M00S03378.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING # 03379 M00S03379.sslabel +++| RETURN; 03380 M00S03380.sslabel +++| END 03381 M00S03381.sslabel +++| 03382 M00S03382.sslabel +++|# 03383 M00S03383.sslabel +++|* LOAD CARTRIDGE FROM INPUT DRAWER. 03384 M00S03384.sslabel +++|# 03385 M00S03385.sslabel +++| 03386 M00S03386.sslabel +++| SP$Y = 14; 03387 M00S03387.sslabel +++| SP$Z = 0; 03388 M00S03388.sslabel +++| REQCODE = REQTYP4"LOAD$CART"; 03389 M00S03389.sslabel +++| CALL4(REQCODE,DRD$NUM,0,SP$Y,SP$Z,RESP$CODE); 03390 M00S03390.sslabel +++| IF RESP$CODE NQ 0 03391 M00S03391.sslabel +++| THEN # *LOAD* FAILS # 03392 M00S03392.sslabel +++| BEGIN 03393 M00S03393.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4"); 03394 M00S03394.sslabel +++| RETURN; 03395 M00S03395.sslabel +++| END 03396 M00S03396.sslabel +++| 03397 M00S03397.sslabel +++| DRD$NUM = CPR$DRD[0]; # TRANSPORT ID # 03398 M00S03398.sslabel +++| 03399 M00S03399.sslabel +++| 03400 M00S03400.sslabel +++| P<LABEL$CART> = OLDLABP; 03401 M00S03401.sslabel +++| CKLAB(LAB$TYPE); # CHECK LABEL TYPE # 03402 M00S03402.sslabel +++| IF LAB$TYPE EQ S"UNR$LAB" 03403 M00S03403.sslabel +++| THEN 03404 M00S03404.sslabel +++| BEGIN # UNRECOGNIZABLE LABEL # 03405 M00S03405.sslabel +++| IF LBARG$ZFM[0] EQ 0 03406 M00S03406.sslabel +++| THEN # FAMILY NOT SPECIFIED # 03407 M00S03407.sslabel +++| BEGIN 03408 M00S03408.sslabel +++| LD$CNT = 0; 03409 M00S03409.sslabel +++| SW$ERR = 0; 03410 M00S03410.sslabel +++| SR$ERR = 0; 03411 M00S03411.sslabel +++| HR$ERR = 0; 03412 M00S03412.sslabel +++| STR$RD = 0; 03413 M00S03413.sslabel +++| STR$WR = 0; 03414 M00S03414.sslabel +++| STR$DM = 0; 03415 M00S03415.sslabel +++| END 03416 M00S03416.sslabel +++| 03417 M00S03417.sslabel +++| ELSE # FAMILY SPECIFIED # 03418 M00S03418.sslabel +++| BEGIN 03419 M00S03419.sslabel +++| REQCODE = REQTYP4"UNLD$CART"; 03420 M00S03420.sslabel +++| CALL4(REQCODE,0,0,SM$EXIT$TY,SM$TY$Z,RESP$CODE); 03421 M00S03421.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4" 03422 M00S03422.sslabel +++| THEN 03423 M00S03423.sslabel +++| BEGIN 03424 M00S03424.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4"); 03425 M00S03425.sslabel +++| RETURN; 03426 M00S03426.sslabel +++| END 03427 M00S03427.sslabel +++| 03428 M00S03428.sslabel +++| ERRCODE = S"UNREC$LAB"; 03429 M00S03429.sslabel +++| LBERR(ERRCODE); 03430 M00S03430.sslabel +++| RETURN; 03431 M00S03431.sslabel +++| END 03432 M00S03432.sslabel +++| 03433 M00S03433.sslabel +++| END # UNRECOGNIZABLE LABEL # 03434 M00S03434.sslabel +++| 03435 M00S03435.sslabel +++| ELSE 03436 M00S03436.sslabel +++| BEGIN # RECOGNIZABLE LABEL # 03437 M00S03437.sslabel +++| IF LBARG$ZFM[0] NQ 0 03438 M00S03438.sslabel +++| THEN 03439 M00S03439.sslabel +++| BEGIN # FAMILY SPECIFIED # 03440 M00S03440.sslabel +++| IF LAB$TYPE EQ S"FAM$LAB" AND LAB$FMLY[0] EQ LBARG$FM[0] AND 03441 M00S03441.sslabel +++| LAB$SF[0] EQ LBARG$SB[0] 03442 M00S03442.sslabel +++| THEN # MATCHING FAMILY LABEL # 03443 M00S03443.sslabel +++| BEGIN 03444 M00S03444.sslabel +++| LD$CNT = LAB$CRLD[0]; 03445 M00S03445.sslabel +++| LD$ERR = LAB$LDER[0]; 03446 M00S03446.sslabel +++| SR$ERR = LAB$SRDE[0]; 03447 M00S03447.sslabel +++| SW$ERR = LAB$SWRE1[0]; 03448 M00S03448.sslabel +++| B<28,4>SW$ERR = LAB$SWRE[0]; 03449 M00S03449.sslabel +++| HR$ERR = LAB$HRDE[0]; 03450 M00S03450.sslabel +++| STR$RD = LAB$STRD[0]; 03451 M00S03451.sslabel +++| STR$WR = LAB$STWR1[0]; 03452 M00S03452.sslabel +++| B<36,24>STR$WR = LAB$STWR[0]; 03453 M00S03453.sslabel +++| STR$DM = LAB$STDM[0]; 03454 M00S03454.sslabel +++| END 03455 M00S03455.sslabel +++| 03456 M00S03456.sslabel +++| ELSE # NO MATCHING FAMILY LABEL # 03457 M00S03457.sslabel +++| BEGIN 03458 M00S03458.sslabel +++| DLABFLD; # DISPLAY LABEL FIELDS # 03459 M00S03459.sslabel +++| REQCODE = REQTYP4"UNLD$CART"; 03460 M00S03460.sslabel +++| CALL4(REQCODE,0,0,SM$EXIT$TY,SM$TY$Z,RESP$CODE); 03461 M00S03461.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4" 03462 M00S03462.sslabel +++| THEN 03463 M00S03463.sslabel +++| BEGIN 03464 M00S03464.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4"); 03465 M00S03465.sslabel +++| RETURN; 03466 M00S03466.sslabel +++| END 03467 M00S03467.sslabel +++| 03468 M00S03468.sslabel +++| ERRCODE = S"NO$FAMLAB"; 03469 M00S03469.sslabel +++| LBERR(ERRCODE); 03470 M00S03470.sslabel +++| RETURN; 03471 M00S03471.sslabel +++| END 03472 M00S03472.sslabel +++| 03473 M00S03473.sslabel +++| END # FAMILY SPECIFIED # 03474 M00S03474.sslabel +++| 03475 M00S03475.sslabel +++| ELSE 03476 M00S03476.sslabel +++| BEGIN # FAMILY NOT SPECIFIED # 03477 M00S03477.sslabel +++| IF LAB$TYPE EQ S"SCR$LAB" 03478 M00S03478.sslabel +++| THEN # SCRATCH LABEL # 03479 M00S03479.sslabel +++| BEGIN 03480 M00S03480.sslabel +++| LD$CNT = LAB$CRLD[0]; 03481 M00S03481.sslabel +++| LD$ERR = LAB$LDER[0]; 03482 M00S03482.sslabel +++| SR$ERR = LAB$SRDE[0]; 03483 M00S03483.sslabel +++| SW$ERR = LAB$SWRE1[0]; 03484 M00S03484.sslabel +++| B<28,4>SW$ERR = LAB$SWRE[0]; 03485 M00S03485.sslabel +++| HR$ERR = LAB$HRDE[0]; 03486 M00S03486.sslabel +++| STR$RD = LAB$STRD[0]; 03487 M00S03487.sslabel +++| STR$WR = LAB$STWR1[0]; 03488 M00S03488.sslabel +++| B<36,24>STR$WR = LAB$STWR[0]; 03489 M00S03489.sslabel +++| STR$DM = LAB$STDM[0]; 03490 M00S03490.sslabel +++| END 03491 M00S03491.sslabel +++| 03492 M00S03492.sslabel +++| ELSE # FAMILY LABEL # 03493 M00S03493.sslabel +++| BEGIN 03494 M00S03494.sslabel +++| REQCODE = REQTYP4"UNLD$CART"; 03495 M00S03495.sslabel +++| CALL4(REQCODE,0,0,SM$EXIT$TY,SM$TY$Z,RESP$CODE); 03496 M00S03496.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4" 03497 M00S03497.sslabel +++| THEN 03498 M00S03498.sslabel +++| BEGIN 03499 M00S03499.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4"); 03500 M00S03500.sslabel +++| RETURN; 03501 M00S03501.sslabel +++| END 03502 M00S03502.sslabel +++| 03503 M00S03503.sslabel +++| DLABFLD; 03504 M00S03504.sslabel +++| ERRCODE = S"GOOD$LAB"; 03505 M00S03505.sslabel +++| LBERR(ERRCODE); 03506 M00S03506.sslabel +++| RETURN; 03507 M00S03507.sslabel +++| END 03508 M00S03508.sslabel +++| 03509 M00S03509.sslabel +++| END # FAMILY NOT SPECIFIED # 03510 M00S03510.sslabel +++| 03511 M00S03511.sslabel +++| END # RECOGNIZABLE LABEL # 03512 M00S03512.sslabel +++| 03513 M00S03513.sslabel +++| LAB$TYPE = S"FAM$LAB"; 03514 M00S03514.sslabel +++| 03515 M00S03515.sslabel +++| 03516 M00S03516.sslabel +++|# 03517 M00S03517.sslabel +++|* CHECK *CSN* PARAMETER FOR MATCH. 03518 M00S03518.sslabel +++|# 03519 M00S03519.sslabel +++| 03520 M00S03520.sslabel +++| CONVSN(TEMP$VSN,1,CONFLAG); 03521 M00S03521.sslabel +++| IF LBARG$C[0] NQ TEMP$VSN 03522 M00S03522.sslabel +++| THEN # NO MATCH OF *CSN* # 03523 M00S03523.sslabel +++| BEGIN 03524 M00S03524.sslabel +++| ERRCODE = S"ILLEG$C"; 03525 M00S03525.sslabel +++| LBERR(ERRCODE); 03526 M00S03526.sslabel +++| RETURN; 03527 M00S03527.sslabel +++| END 03528 M00S03528.sslabel +++| 03529 M00S03529.sslabel +++|# 03530 M00S03530.sslabel +++|* CONVERT VSN FROM DISPLAY CODE TO EBCDIC. 03531 M00S03531.sslabel +++|# 03532 M00S03532.sslabel +++| 03533 M00S03533.sslabel +++| DC$VSN = LBARG$C[0]; 03534 M00S03534.sslabel +++| CONVSN(DC$VSN,0,CONFLAG); 03535 M00S03535.sslabel +++| IF CONFLAG 03536 M00S03536.sslabel +++| THEN # ILLEGAL CDC CHARACTER # 03537 M00S03537.sslabel +++| BEGIN 03538 M00S03538.sslabel +++| ERRCODE = S"ILLEG$C"; 03539 M00S03539.sslabel +++| LBERR(ERRCODE); 03540 M00S03540.sslabel +++| RETURN; 03541 M00S03541.sslabel +++| END 03542 M00S03542.sslabel +++| 03543 M00S03543.sslabel +++|# 03544 M00S03544.sslabel +++|* GENERATE NEW LABEL. 03545 M00S03545.sslabel +++|# 03546 M00S03546.sslabel +++| 03547 M00S03547.sslabel +++| LAB$TYPE = S"SCR$LAB"; 03548 M00S03548.sslabel +++| GENLAB(LAB$TYPE,PT$CSU$ENT[0],LD$CNT,LD$ERR, SR$ERR,SW$ERR, 03549 M00S03549.sslabel +++| HR$ERR); 03550 M00S03550.sslabel +++| IF LBARG$CM[0] NQ IBMCART 03551 M00S03551.sslabel +++| THEN # CARTRIDGE NOT IBM # 03552 M00S03552.sslabel +++| BEGIN 03553 M00S03553.sslabel +++| LAB$CCOD[0] = OTHCART; 03554 M00S03554.sslabel +++| END 03555 M00S03555.sslabel +++| 03556 M00S03556.sslabel +++| ELSE 03557 M00S03557.sslabel +++| BEGIN 03558 M00S03558.sslabel +++| LAB$CCOD[0] = IBMCART; 03559 M00S03559.sslabel +++| END 03560 M00S03560.sslabel +++| 03561 M00S03561.sslabel +++| IF LBARG$CM[0] EQ IBMCART 03562 M00S03562.sslabel +++| THEN # WRITE IBM ON CARTRIDGE # 03563 M00S03563.sslabel +++| BEGIN 03564 M00S03564.sslabel +++| B<0,32>LAB$CSN[0] = O"31160552100"; 03565 M00S03565.sslabel +++| END 03566 M00S03566.sslabel +++| 03567 M00S03567.sslabel +++| # NOTE: IF CM EQ B- THEN DO 03568 M00S03568.sslabel +++| CONVERSION # 03569 M00S03569.sslabel +++| REQCODE = REQTYP4"WRT$LAB"; 03570 M00S03570.sslabel +++| CALL4(REQCODE,DRD$NUM,CART$CSN,PT$Y[0],PT$Z[0],RESP$CODE); 03571 M00S03571.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4" 03572 M00S03572.sslabel +++| THEN # WRITE FAILS # 03573 M00S03573.sslabel +++| BEGIN 03574 M00S03574.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4"); 03575 M00S03575.sslabel +++| RETURN; 03576 M00S03576.sslabel +++| END 03577 M00S03577.sslabel +++| 03578 M00S03578.sslabel +++|# 03579 M00S03579.sslabel +++|* UPDATE SMMAP TO ADD CARTRIDGE TO POOL. 03580 M00S03580.sslabel +++|# 03581 M00S03581.sslabel +++| 03582 M00S03582.sslabel +++| REQCODE = REQTYP3"UPD$MAP"; 03583 M00S03583.sslabel +++| P<SMUMAP> = LOC(PT$CSU$ENT[0]); 03584 M00S03584.sslabel +++| CM$CSND[0] = LBARG$C[0]; 03585 M00S03585.sslabel +++| CM$CCOD[0] = LAB$CCOD; 03586 M00S03586.sslabel +++| CALL3(REQCODE,PT$CSU$ENT[0],0,0,RESP$CODE); 03587 M00S03587.sslabel +++| IF RESP$CODE NQ RESPTYP3"OK3" 03588 M00S03588.sslabel +++| THEN # UPDATE FAILS # 03589 M00S03589.sslabel +++| BEGIN 03590 M00S03590.sslabel +++| LBRESP(RESP$CODE,TYP"TYP3"); 03591 M00S03591.sslabel +++| RETURN; 03592 M00S03592.sslabel +++| END 03593 M00S03593.sslabel +++| 03594 M00S03594.sslabel +++| # WHICH ERROR CODE # 03595 M00S03595.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4" 03596 M00S03596.sslabel +++| THEN # PUT FAILS # 03597 M00S03597.sslabel +++| BEGIN 03598 M00S03598.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4"); 03599 M00S03599.sslabel +++| END 03600 M00S03600.sslabel +++| 03601 M00S03601.sslabel +++| RETURN; 03602 M00S03602.sslabel +++| 03603 M00S03603.sslabel +++| END # LBFXVSN # 03604 M00S03604.sslabel +++| 03605 M00S03605.sslabel +++| TERM 03606 M00S03606.sslabel +++|PROC LBHEAD((FETP)); 03607 M00S03607.sslabel +++|# TITLE LBHEAD - WRITES HEADER LINE ON OUTPUT FILE. # 03608 M00S03608.sslabel +++| 03609 M00S03609.sslabel +++| BEGIN # LBHEAD # 03610 M00S03610.sslabel +++| 03611 M00S03611.sslabel +++|# 03612 M00S03612.sslabel +++|** LBHEAD - WRITES HEADER LINE ON OUTPUT FILE. 03613 M00S03613.sslabel +++|* 03614 M00S03614.sslabel +++|* PROC LBHEAD((FETP)) 03615 M00S03615.sslabel +++|* 03616 M00S03616.sslabel +++|* ENTRY FETP, AN ITEM CONTAINING THE FWA OF THE FET. 03617 M00S03617.sslabel +++|* 03618 M00S03618.sslabel +++|* EXIT HEADER WRITTEN ON OUTPUT FILE. 03619 M00S03619.sslabel +++|* 03620 M00S03620.sslabel +++|* NOTES THE REPORT FORMATTER IS USED TO 03621 M00S03621.sslabel +++|* PRINT THE HEADER LINES. 03622 M00S03622.sslabel +++|# 03623 M00S03623.sslabel +++| 03624 M00S03624.sslabel +++| ITEM FETP I; # FWA OF THE FET # 03625 M00S03625.sslabel +++| 03626 M00S03626.sslabel +++|# 03627 M00S03627.sslabel +++|**** PROC LBHEAD - XREF LIST BEGIN. 03628 M00S03628.sslabel +++|# 03629 M00S03629.sslabel +++| 03630 M00S03630.sslabel +++| XREF 03631 M00S03631.sslabel +++| BEGIN 03632 M00S03632.sslabel +++| PROC RPLINEX; # PRINTS A REPORT LINE # 03633 M00S03633.sslabel +++| END 03634 M00S03634.sslabel +++| 03635 M00S03635.sslabel +++|# 03636 M00S03636.sslabel +++|**** PROC LBHEAD - XREF LIST END. 03637 M00S03637.sslabel +++|# 03638 M00S03638.sslabel +++| 03639 M00S03639.sslabel +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS # 03640 M00S03640.sslabel +++|*CALL COMBFAS 03641 M00S03641.sslabel +++|*CALL COMTOUT 03642 M00S03642.sslabel +++| 03643 M00S03643.sslabel +++| CONTROL EJECT; 03644 M00S03644.sslabel +++| 03645 M00S03645.sslabel +++|# 03646 M00S03646.sslabel +++|* PRINT HEADER LINE. 03647 M00S03647.sslabel +++|# 03648 M00S03648.sslabel +++| 03649 M00S03649.sslabel +++| RPLINEX(FETP,"SSLABEL REPORT FILE",2,19,0); 03650 M00S03650.sslabel +++| RPLINEX(FETP," ",1,1,0); # WRITE A BLANK LINE # 03651 M00S03651.sslabel +++| RETURN; 03652 M00S03652.sslabel +++| 03653 M00S03653.sslabel +++| END # LBHEAD # 03654 M00S03654.sslabel +++| 03655 M00S03655.sslabel +++| TERM 03656 M00S03656.sslabel +++|PROC LBLOOP((ARGLIST),ERRFLAG); 03657 M00S03657.sslabel +++|# TITLE LBLOOP - CRACK AND SYNTAX CHECK *SSLABEL* DIRECTIVES. # 03658 M00S03658.sslabel +++| 03659 M00S03659.sslabel +++| BEGIN # LBLOOP # 03660 M00S03660.sslabel +++| 03661 M00S03661.sslabel +++|# 03662 M00S03662.sslabel +++|** LBLOOP - CRACK AND SYNTAX CHECK *SSLABEL* DIRECTIVES. 03663 M00S03663.sslabel +++|* 03664 M00S03664.sslabel +++|* THIS PROCEDURE CRACKS AND SYNTAX CHECKS THE 03665 M00S03665.sslabel +++|* PARAMETERS SPECIFIED ON *SSLABEL* DIRECTIVE 03666 M00S03666.sslabel +++|* CALL. 03667 M00S03667.sslabel +++|* 03668 M00S03668.sslabel +++|* PROC LBLOOP((ARGLIST),ERRFLAG) 03669 M00S03669.sslabel +++|* 03670 M00S03670.sslabel +++|* ENTRY ARGLIST, AN ITEM CONTAINING THE ADDRESS 03671 M00S03671.sslabel +++|* OF THE ARGUMENT LIST FOR *SSLABEL*. 03672 M00S03672.sslabel +++|* 03673 M00S03673.sslabel +++|* EXIT ALL THE DIRECTIVES CRACKED, SYNTAX CHECKED 03674 M00S03674.sslabel +++|* AND WRITTEN ON A TEMPORARY FILE. 03675 M00S03675.sslabel +++|* ERRFLAG, AN ITEM CONTAINING THE ERROR STATUS. 03676 M00S03676.sslabel +++|* FALSE, NO ERROR. 03677 M00S03677.sslabel +++|* TRUE, SYNTAX ERROR IN ONE OR MORE DIRECTIVES. 03678 M00S03678.sslabel +++|* 03679 M00S03679.sslabel +++|* MESSAGES SSLABEL - NO DIRECTIVES. 03680 M00S03680.sslabel +++|* 03681 M00S03681.sslabel +++|* NOTES PROC *LBLOOP* SETS UP A LOOP TO READ IN EACH 03682 M00S03682.sslabel +++|* DIRECTIVE, CRACK THE DIRECTIVE, CONVERT THE CRACKED 03683 M00S03683.sslabel +++|* PARAMETERS FROM DISPLAY CODE TO INTEGER VALUE 03684 M00S03684.sslabel +++|* AND TO CHECK FOR THE VALID OPTIONS ON THE 03685 M00S03685.sslabel +++|* DIRECTIVE CALL. THE CRACKED PARAMETERS ARE 03686 M00S03686.sslabel +++|* RETURNED IN THE COMMON AREA *ULBPCOM* AND 03687 M00S03687.sslabel +++|* AFTER CONVERSION ARE PLACED BACK IN THE 03688 M00S03688.sslabel +++|* SAME LOCATIONS. IF AN ERROR IS ENCOUNTERED 03689 M00S03689.sslabel +++|* WITH THE DIRECTIVE, A DIRECTIVE ERROR FLAG 03690 M00S03690.sslabel +++|* IS SET UP. THE DIRECTIVE ALONG WITH THE 03691 M00S03691.sslabel +++|* CRACKED AND CONVERTED PARAMETERS, DIRECTIVE 03692 M00S03692.sslabel +++|* NUMBER AND THE DIRECTIVE ERROR STATUS FLAG 03693 M00S03693.sslabel +++|* IS WRITTEN TO A TEMPORARY FILE. THE TEMPORARY 03694 M00S03694.sslabel +++|* FILE HAS THE FOLLOWING FORMAT. 03695 M00S03695.sslabel +++|* EACH DIRECTIVE HAS ITS IMAGE, NUMBER AND 03696 M00S03696.sslabel +++|* ERROR STATUS AND THE CRACKED PARAMETERS 03697 M00S03697.sslabel +++|* WRITTEN ON TO IT. IT CONSISTS OF 03698 M00S03698.sslabel +++|* ONE LOGICAL RECORD FOLLOWED BY AN EOR. 03699 M00S03699.sslabel +++|* A SYNTAX ERROR IS RETURNED TO THE CALLING 03700 M00S03700.sslabel +++|* PROCEDURE IF AN ERROR IS ENCOUNTERED WITH 03701 M00S03701.sslabel +++|* ANY DIRECTIVE. 03702 M00S03702.sslabel +++|# 03703 M00S03703.sslabel +++| 03704 M00S03704.sslabel +++| ITEM ARGLIST I; # ADDRESS OF ARGUMENT LIST # 03705 M00S03705.sslabel +++| ITEM ERRFLAG B; # ERROR FLAG # 03706 M00S03706.sslabel +++| 03707 M00S03707.sslabel +++|# 03708 M00S03708.sslabel +++|**** PROC LBLOOP - XREF LIST BEGIN. 03709 M00S03709.sslabel +++|# 03710 M00S03710.sslabel +++| 03711 M00S03711.sslabel +++| XREF 03712 M00S03712.sslabel +++| BEGIN 03713 M00S03713.sslabel +++| PROC BZFILL; # BLANK OR ZERO FILLS A BUFFER # 03714 M00S03714.sslabel +++| PROC LBCONV; # CONVERT PARAMETERS TO INTEGERS # 03715 M00S03715.sslabel +++| PROC LBERR; # *SSLABEL* ERROR PROCESSOR # 03716 M00S03716.sslabel +++| PROC LBOPT; # CHECKS FOR VALID OPTIONS # 03717 M00S03717.sslabel +++| PROC LOFPROC; # LIST OF FILES PROCESSOR # 03718 M00S03718.sslabel +++| PROC MESSAGE; # DISPLAYS MESSAGES # 03719 M00S03719.sslabel +++| PROC READC; # READS IN A CODED LINE # 03720 M00S03720.sslabel +++| PROC RESTPFP; # RESTORE USER-S *PFP* AND ABORT 03721 M00S03721.sslabel +++| OR RETURN # 03722 M00S03722.sslabel +++| PROC RETERN; # RETURNS A FILE # 03723 M00S03723.sslabel +++| PROC REWIND; # REWINDS A FILE # 03724 M00S03724.sslabel +++| PROC RPLINE; # PRINTS A REPORT LINE # 03725 M00S03725.sslabel +++| PROC RPSPACE; # PRINTS A BLANK LINE # 03726 M00S03726.sslabel +++| PROC WRITER; # WRITES EOR ON A FILE # 03727 M00S03727.sslabel +++| PROC WRITEW; # DATA TRANSFER ROUTINE # 03728 M00S03728.sslabel +++| PROC XARG; # CRACK PARAMETER LIST # 03729 M00S03729.sslabel +++| FUNC XCDD C(10); # CONVERT INTEGERS TO DISPLAY # 03730 M00S03730.sslabel +++| PROC ZFILL; # ZERO FILLS A BUFFER # 03731 M00S03731.sslabel +++| PROC ZSETFET; # SETS UP A CIO FET # 03732 M00S03732.sslabel +++| END 03733 M00S03733.sslabel +++| 03734 M00S03734.sslabel +++|# 03735 M00S03735.sslabel +++|**** PROC LBLOOP - XREF LIST END. 03736 M00S03736.sslabel +++|# 03737 M00S03737.sslabel +++| 03738 M00S03738.sslabel +++| DEF WBUFL #8#; # LENGTH OF WORKING BUFFER # 03739 M00S03739.sslabel +++| 03740 M00S03740.sslabel +++| DEF LISTCON #0#; # DO NOT LIST THE COMDECKS # 03741 M00S03741.sslabel +++|*CALL COMBFAS 03742 M00S03742.sslabel +++|*CALL COMBBZF 03743 M00S03743.sslabel +++|*CALL COMTERR 03744 M00S03744.sslabel +++|*CALL COMTLAB 03745 M00S03745.sslabel +++|*CALL COMTLBP 03746 M00S03746.sslabel +++|*CALL COMTOUT 03747 M00S03747.sslabel +++| 03748 M00S03748.sslabel +++| ITEM BUFP I; # FIRST WORD ADDRESS OF BUFFER # 03749 M00S03749.sslabel +++| ITEM COMMENT B = FALSE; # INDICATES A COMMENT # 03750 M00S03750.sslabel +++| ITEM DIRNUM I; # DIRECTIVE NUMBER # 03751 M00S03751.sslabel +++| ITEM EOR B = FALSE; # EOR STATUS ON A FILE # 03752 M00S03752.sslabel +++| ITEM FETP I; # FIRST WORD ADDRESS OF FET # 03753 M00S03753.sslabel +++| ITEM FLAG I; # ERROR FLAG # 03754 M00S03754.sslabel +++| ITEM TEMP C(10); # TEMPORARY ITEM # 03755 M00S03755.sslabel +++| 03756 M00S03756.sslabel +++| ARRAY LBIN$WBUF [0:0] S(WBUFL); # WORKING BUFFER # 03757 M00S03757.sslabel +++| BEGIN 03758 M00S03758.sslabel +++| ITEM LBINW$DIR C(00,00,80); # *SSLABEL* DIRECTIVE IMAGE # 03759 M00S03759.sslabel +++| END 03760 M00S03760.sslabel +++| 03761 M00S03761.sslabel +++| CONTROL EJECT; 03762 M00S03762.sslabel +++| 03763 M00S03763.sslabel +++| DIRNUM = 0; # INITIALIZE DIRECTIVE NUMBER # 03764 M00S03764.sslabel +++| 03765 M00S03765.sslabel +++|# 03766 M00S03766.sslabel +++|* SET UP FET FOR TEMPORARY FILE. 03767 M00S03767.sslabel +++|# 03768 M00S03768.sslabel +++| 03769 M00S03769.sslabel +++| FETP = LOC(SCR$FET[0]); 03770 M00S03770.sslabel +++| BUFP = LOC(SCR$BUF[0]); 03771 M00S03771.sslabel +++| ZSETFET(FETP,SCR,BUFP,BUFL,SFETL); 03772 M00S03772.sslabel +++| LOFPROC(SCR); # ADD LFN TO LIST OF FILES # 03773 M00S03773.sslabel +++| 03774 M00S03774.sslabel +++|# 03775 M00S03775.sslabel +++|* SET UP A LOOP TO 03776 M00S03776.sslabel +++|* 1. READ A DIRECTIVE. 03777 M00S03777.sslabel +++|* 2. CRACK THE DIRECTIVE. 03778 M00S03778.sslabel +++|* 3. CONVERT PARAMETERS. 03779 M00S03779.sslabel +++|* 4. CHECK FOR VALID OPTIONS. 03780 M00S03780.sslabel +++|* 5. WRITE THE DIRECTIVE TO A TEMPORARY FILE. 03781 M00S03781.sslabel +++|# 03782 M00S03782.sslabel +++| 03783 M00S03783.sslabel +++| RETERN(SCR$FET[0],RCL); # RETURN THE TEMPORARY FILE # 03784 M00S03784.sslabel +++| 03785 M00S03785.sslabel +++| FASTFOR DUMMY = 0 STEP 1 WHILE NOT EOR 03786 M00S03786.sslabel +++| DO 03787 M00S03787.sslabel +++| BEGIN # CRACK AND SYNTAX CHECK DIRECTIVES # 03788 M00S03788.sslabel +++| ZFILL(LBIN$WBUF[0],WBUFL); # ZERO FILL WORKING BUFFER # 03789 M00S03789.sslabel +++| READC(LBIN$FET[0],LBIN$WBUF[0],WBUFL,FLAG); 03790 M00S03790.sslabel +++| IF FLAG NQ 0 03791 M00S03791.sslabel +++| THEN # NO MORE DIRECTIVES # 03792 M00S03792.sslabel +++| BEGIN 03793 M00S03793.sslabel +++| EOR = TRUE; 03794 M00S03794.sslabel +++| TEST DUMMY; 03795 M00S03795.sslabel +++| END 03796 M00S03796.sslabel +++| 03797 M00S03797.sslabel +++|# 03798 M00S03798.sslabel +++|* CHECK FOR A COMMENT. 03799 M00S03799.sslabel +++|# 03800 M00S03800.sslabel +++| 03801 M00S03801.sslabel +++| IF C<0,1>LBINW$DIR[0] EQ "*" 03802 M00S03802.sslabel +++| THEN # A COMMENT # 03803 M00S03803.sslabel +++| BEGIN 03804 M00S03804.sslabel +++| COMMENT = TRUE; 03805 M00S03805.sslabel +++| TEMP = " "; 03806 M00S03806.sslabel +++| END 03807 M00S03807.sslabel +++| 03808 M00S03808.sslabel +++| ELSE # A DIRECTIVE # 03809 M00S03809.sslabel +++| BEGIN 03810 M00S03810.sslabel +++| COMMENT = FALSE; 03811 M00S03811.sslabel +++| DIRNUM = DIRNUM + 1; 03812 M00S03812.sslabel +++| TEMP = XCDD(DIRNUM); # WRITE DIRECTIVE NUMBER # 03813 M00S03813.sslabel +++| TEMP = C<7,3>TEMP; 03814 M00S03814.sslabel +++| END 03815 M00S03815.sslabel +++| 03816 M00S03816.sslabel +++|# 03817 M00S03817.sslabel +++|* WRITE THE DIRECTIVE NUMBER AND THE DIRECTIVE 03818 M00S03818.sslabel +++|* IMAGE TO THE OUTPUT FILE. 03819 M00S03819.sslabel +++|# 03820 M00S03820.sslabel +++| 03821 M00S03821.sslabel +++| BZFILL(LBIN$WBUF[0],TYPFILL"BFILL",80); 03822 M00S03822.sslabel +++| RPLINE(OUT$FETP,TEMP,2,5,1); 03823 M00S03823.sslabel +++| RPLINE(OUT$FETP,LBINW$DIR[0],8,80,0); 03824 M00S03824.sslabel +++| RPSPACE(OUT$FETP,SP"SPACE",1); 03825 M00S03825.sslabel +++| 03826 M00S03826.sslabel +++| IF COMMENT 03827 M00S03827.sslabel +++| THEN 03828 M00S03828.sslabel +++| BEGIN 03829 M00S03829.sslabel +++| TEST DUMMY; # READ THE NEXT DIRECTIVE # 03830 M00S03830.sslabel +++| END 03831 M00S03831.sslabel +++| 03832 M00S03832.sslabel +++|# 03833 M00S03833.sslabel +++|* ZERO FILL THE AREA TO HOLD THE DIRECTIVE 03834 M00S03834.sslabel +++|* IMAGE AND THE CRACKED PARAMETERS. 03835 M00S03835.sslabel +++|# 03836 M00S03836.sslabel +++| 03837 M00S03837.sslabel +++| ZFILL(LBARG[0],DIRPRML); 03838 M00S03838.sslabel +++| 03839 M00S03839.sslabel +++|# 03840 M00S03840.sslabel +++|* SET UP THE DIRECTIVE IMAGE AND THE DIRECTIVE 03841 M00S03841.sslabel +++|* NUMBER IN THE AREA TO BE WRITTEN TO THE 03842 M00S03842.sslabel +++|* TEMPORARY FILE. 03843 M00S03843.sslabel +++|# 03844 M00S03844.sslabel +++| 03845 M00S03845.sslabel +++| LBARG$DIRN[0] = TEMP; 03846 M00S03846.sslabel +++| LBARG$DIRI[0] = LBINW$DIR[0]; # DIRECTIVE IMAGE # 03847 M00S03847.sslabel +++| 03848 M00S03848.sslabel +++|# 03849 M00S03849.sslabel +++|* CRACK THE DIRECTIVE. 03850 M00S03850.sslabel +++|# 03851 M00S03851.sslabel +++| 03852 M00S03852.sslabel +++| LBARG$GR[0] = 7777; 03853 M00S03853.sslabel +++| XARG(ARGLIST,LBIN$WBUF[0],FLAG); # OPTION IS *DO NOT SKIP OVER 03854 M00S03854.sslabel +++| PROGRAM NAME* # 03855 M00S03855.sslabel +++| IF FLAG NQ 0 03856 M00S03856.sslabel +++| THEN # SYNTAX ERROR # 03857 M00S03857.sslabel +++| BEGIN 03858 M00S03858.sslabel +++| LBARG$DIRF[0] = TRUE; # SET UP ERROR FLAGS # 03859 M00S03859.sslabel +++| ERRFLAG = TRUE; 03860 M00S03860.sslabel +++| END 03861 M00S03861.sslabel +++| 03862 M00S03862.sslabel +++|# 03863 M00S03863.sslabel +++|* IF NO SYNTAX ERROR IN THE DIRECTIVE THEN CONVERT 03864 M00S03864.sslabel +++|* THE PARAMETERS FROM DISPLAY CODE TO INTEGER VALUE. 03865 M00S03865.sslabel +++|# 03866 M00S03866.sslabel +++| 03867 M00S03867.sslabel +++| IF NOT LBARG$DIRF[0] 03868 M00S03868.sslabel +++| THEN # NO ERROR IN DIRECTIVE # 03869 M00S03869.sslabel +++| BEGIN 03870 M00S03870.sslabel +++| LBCONV(FLAG); # CONVERT PARAMETERS # 03871 M00S03871.sslabel +++| IF FLAG NQ 0 03872 M00S03872.sslabel +++| THEN # CONVERSION ERROR # 03873 M00S03873.sslabel +++| BEGIN 03874 M00S03874.sslabel +++| LBARG$DIRF[0] = TRUE; # SET UP ERROR FLAGS # 03875 M00S03875.sslabel +++| ERRFLAG = TRUE; 03876 M00S03876.sslabel +++| END 03877 M00S03877.sslabel +++| 03878 M00S03878.sslabel +++| END 03879 M00S03879.sslabel +++| 03880 M00S03880.sslabel +++|# 03881 M00S03881.sslabel +++|* IF AN ERROR IS FOUND IN THE DIRECTIVE, REPORT 03882 M00S03882.sslabel +++|* IT ON THE OUTPUT FILE. 03883 M00S03883.sslabel +++|# 03884 M00S03884.sslabel +++| 03885 M00S03885.sslabel +++| IF LBARG$DIRF[0] 03886 M00S03886.sslabel +++| THEN # ERROR IN THE DIRECTIVE # 03887 M00S03887.sslabel +++| BEGIN 03888 M00S03888.sslabel +++| ERRCODE = S"SYNTX$DIR"; 03889 M00S03889.sslabel +++| LBERR(ERRCODE); # PROCESS THE ERROR # 03890 M00S03890.sslabel +++| END 03891 M00S03891.sslabel +++| 03892 M00S03892.sslabel +++|# 03893 M00S03893.sslabel +++|* IF THERE IS NO ERROR IN THE DIRECTIVE, CHECK 03894 M00S03894.sslabel +++|* FOR ALL THE VALID OPTIONS ON THE DIRECTIVE 03895 M00S03895.sslabel +++|* CALL. 03896 M00S03896.sslabel +++|# 03897 M00S03897.sslabel +++| 03898 M00S03898.sslabel +++| IF NOT LBARG$DIRF[0] 03899 M00S03899.sslabel +++| THEN # CHECK FOR VALID OPTIONS # 03900 M00S03900.sslabel +++| BEGIN 03901 M00S03901.sslabel +++| LBOPT(FLAG); 03902 M00S03902.sslabel +++| IF FLAG NQ 0 03903 M00S03903.sslabel +++| THEN # VALID OPTIONS VIOLATED # 03904 M00S03904.sslabel +++| BEGIN 03905 M00S03905.sslabel +++| LBARG$DIRF[0] = TRUE; # SET UP ERROR FLAGS # 03906 M00S03906.sslabel +++| ERRFLAG = TRUE; 03907 M00S03907.sslabel +++| END 03908 M00S03908.sslabel +++| 03909 M00S03909.sslabel +++| END 03910 M00S03910.sslabel +++| 03911 M00S03911.sslabel +++|# 03912 M00S03912.sslabel +++|* WRITE THE DIRECTIVE IMAGE ALONG WITH THE DIRECTIVE 03913 M00S03913.sslabel +++|* NUMBER, DIRECTIVE FLAG AND THE CRACKED PARAMETERS 03914 M00S03914.sslabel +++|* ON THE TEMPORARY FILE. 03915 M00S03915.sslabel +++|# 03916 M00S03916.sslabel +++| 03917 M00S03917.sslabel +++| WRITEW(SCR$FET[0],LBARG[0],DIRPRML,FLAG); 03918 M00S03918.sslabel +++| END # CRACK AND SYNTAX CHECK DIRECTIVES # 03919 M00S03919.sslabel +++| 03920 M00S03920.sslabel +++| IF DIRNUM EQ 0 03921 M00S03921.sslabel +++| THEN # NO DIRECTIVES # 03922 M00S03922.sslabel +++| BEGIN 03923 M00S03923.sslabel +++| LBMSG$LINE[0] = " SSLABEL - NO DIRECTIVES."; 03924 M00S03924.sslabel +++| MESSAGE(LBMSG$BUF[0],SYSUDF1); 03925 M00S03925.sslabel +++| RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT # 03926 M00S03926.sslabel +++| END 03927 M00S03927.sslabel +++| 03928 M00S03928.sslabel +++| WRITER(SCR$FET[0],NRCL); 03929 M00S03929.sslabel +++| REWIND(SCR$FET[0],NRCL); 03930 M00S03930.sslabel +++| RETURN; # ALL DIRECTIVES CRACKED # 03931 M00S03931.sslabel +++| 03932 M00S03932.sslabel +++| END # LBLOOP # 03933 M00S03933.sslabel +++| 03934 M00S03934.sslabel +++| TERM 03935 M00S03935.sslabel +++|PROC LBMAIN; 03936 M00S03936.sslabel +++|# TITLE LBMAIN - PROCESSES *SSLABEL* DIRECTIVES. # 03937 M00S03937.sslabel +++| 03938 M00S03938.sslabel +++| BEGIN # LBMAIN # 03939 M00S03939.sslabel +++| 03940 M00S03940.sslabel +++|# 03941 M00S03941.sslabel +++|** LBMAIN - PROCESSES *SSLABEL* DIRECTIVES. 03942 M00S03942.sslabel +++|* 03943 M00S03943.sslabel +++|* THIS PROCEDURE PROCESSES DIRECTIVES BY CALLING 03944 M00S03944.sslabel +++|* THE APPROPRIATE DIRECTIVE ROUTINES. 03945 M00S03945.sslabel +++|* 03946 M00S03946.sslabel +++|* PROC LBMAIN. 03947 M00S03947.sslabel +++|* 03948 M00S03948.sslabel +++|* ENTRY THE TEMPORARY FILE SET UP WITH 03949 M00S03949.sslabel +++|* THE DIRECTIVE IMAGES ALONG WITH THE 03950 M00S03950.sslabel +++|* CRACKED PARAMETERS. 03951 M00S03951.sslabel +++|* 03952 M00S03952.sslabel +++|* EXIT ALL DIRECTIVES HAVE BEEN PROCESSED. 03953 M00S03953.sslabel +++|* 03954 M00S03954.sslabel +++|* MESSAGES FAMILY NOT FOUND. 03955 M00S03955.sslabel +++|* 03956 M00S03956.sslabel +++|* NOTES THE CRACKED PARAMETER FILE IS READ (UNTIL EOI) 03957 M00S03957.sslabel +++|* INTO WORKING STORAGE. FOR EACH DIRECTIVE, THE 03958 M00S03958.sslabel +++|* DIRECTIVE IMAGE IS WRITTEN ON THE OUTPUT FILE 03959 M00S03959.sslabel +++|* AND THE SMMAP IS OPENED. IF THIS OPEN FAILS, 03960 M00S03960.sslabel +++|* OR IF THE SYNTAX ERROR FLAG IS SET FOR THIS 03961 M00S03961.sslabel +++|* DIRECTIVE, THEN THE ERROR PROCESSOR IS CALLED. 03962 M00S03962.sslabel +++|* OTHERWISE THE CORRESPONDING DIRECTIVE ROUTINE 03963 M00S03963.sslabel +++|* IS CALLED. 03964 M00S03964.sslabel +++|# 03965 M00S03965.sslabel +++| 03966 M00S03966.sslabel +++|# 03967 M00S03967.sslabel +++|**** PROC LBMAIN - XREF LIST BEGIN. 03968 M00S03968.sslabel +++|# 03969 M00S03969.sslabel +++| 03970 M00S03970.sslabel +++| XREF 03971 M00S03971.sslabel +++| BEGIN 03972 M00S03972.sslabel +++| PROC SSINIT; # SET UP TABLES AND POINTERS # 03973 M00S03973.sslabel +++| PROC LBADCSU; # ADD *SM* DIRECTIVE (AC) # 03974 M00S03974.sslabel +++| PROC LBADCUB; # ADD CUBE (AB) # 03975 M00S03975.sslabel +++| PROC LBADMSC; # ADD CARTRIDGE (AM) # 03976 M00S03976.sslabel +++| PROC LBERR; # *SSLABEL* ERROR PROCESSOR # 03977 M00S03977.sslabel +++| PROC LBFLMSC; # SET/CLEAR FCT INHIB FLAG (IB) # 03978 M00S03978.sslabel +++| PROC LBFXVSN; # REPAIR LABEL (FX) # 03979 M00S03979.sslabel +++| PROC LBRESP; # RESPONSE CODE PROCESSOR # 03980 M00S03980.sslabel +++| PROC LBRMCSU; # REMOVE *SM* DIRECTIVE (RC) # 03981 M00S03981.sslabel +++| PROC LBRMCUB; # REMOVE CUBE DIRECTIVE (RB) # 03982 M00S03982.sslabel +++| PROC LBRMMSC; # REMOVE CARTRIDGE (RM) # 03983 M00S03983.sslabel +++| PROC LBRSMSC; # RESTORE A CARTRIDGE (RS) # 03984 M00S03984.sslabel +++| PROC LOFPROC; # LIST OF FILES PROCESSOR # 03985 M00S03985.sslabel +++| PROC MESSAGE; # DISPLAYS MESSAGES # 03986 M00S03986.sslabel +++| PROC MOPEN; # OPEN SMMAP # 03987 M00S03987.sslabel +++| PROC READ; # CIO READ MACRO # 03988 M00S03988.sslabel +++| PROC READW; # CIO READW MACRO # 03989 M00S03989.sslabel +++| PROC RESTPFP; # RESTORE USER-S *PFP* AND ABORT 03990 M00S03990.sslabel +++| OR RETURN # 03991 M00S03991.sslabel +++| PROC RETERN; # RETURN MACRO # 03992 M00S03992.sslabel +++| PROC RPLINE; # PRINT FORMATTER ROUTINE # 03993 M00S03993.sslabel +++| PROC RPSPACE; # PRINTS BLANK LINES # 03994 M00S03994.sslabel +++| PROC SETPFP; # SET FAMILY AND USER INDEX # 03995 M00S03995.sslabel +++| END 03996 M00S03996.sslabel +++| 03997 M00S03997.sslabel +++|# 03998 M00S03998.sslabel +++|**** PROC LBMAIN - XREF LIST END. 03999 M00S03999.sslabel +++|# 04000 M00S04000.sslabel +++| 04001 M00S04001.sslabel +++| DEF MSG1 #" FAMILY NOT FOUND."#; 04002 M00S04002.sslabel +++| 04003 M00S04003.sslabel +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS # 04004 M00S04004.sslabel +++|*CALL COMBFAS 04005 M00S04005.sslabel +++|*CALL COMBCMD 04006 M00S04006.sslabel +++|*CALL COMBCMS 04007 M00S04007.sslabel +++|*CALL COMBCPR 04008 M00S04008.sslabel +++|*CALL COMBLBL 04009 M00S04009.sslabel +++|*CALL COMBPFP 04010 M00S04010.sslabel +++|*CALL COMBSNS 04011 M00S04011.sslabel +++|*CALL COMSPFM 04012 M00S04012.sslabel +++|*CALL COMTERR 04013 M00S04013.sslabel +++|*CALL COMTLAB 04014 M00S04014.sslabel +++|*CALL COMTLBP 04015 M00S04015.sslabel +++|*CALL COMTOUT 04016 M00S04016.sslabel +++| 04017 M00S04017.sslabel +++| ITEM J I; # LOOP VARIABLE # 04018 M00S04018.sslabel +++| ITEM MSTAT S:CMASTAT; # ERROR STATUS # 04019 M00S04019.sslabel +++| ITEM RDWSTAT I = 0; # ERROR STATUS # 04020 M00S04020.sslabel +++| 04021 M00S04021.sslabel +++| ARRAY CMAP$NM [0:0] P(1); # BUILD SMMAP FILE NAME # 04022 M00S04022.sslabel +++| BEGIN 04023 M00S04023.sslabel +++| ITEM CMAP$NAME C(00,00,07); # SMMAP FILE NAME # 04024 M00S04024.sslabel +++| ITEM CMAP$IN C(00,00,05); # FIRST 5 CHARACTERS # 04025 M00S04025.sslabel +++| ITEM CMAP$ID C(00,30,01); # CSU-ID # 04026 M00S04026.sslabel +++| ITEM CMAP$Z U(00,36,24) = [0]; # ZERO FILL FILE NAME # 04027 M00S04027.sslabel +++| END 04028 M00S04028.sslabel +++| 04029 M00S04029.sslabel +++| ARRAY DRW$STAT [0:0] S(SNSLEN);; # DRAWER STATUS TABLE # 04030 M00S04030.sslabel +++| 04031 M00S04031.sslabel +++|# 04032 M00S04032.sslabel +++|* BUFFERS TO HOLD THE OLD CARTRIDGE LABEL 04033 M00S04033.sslabel +++|* AND THE NEW CARTRIDGE LABEL. 04034 M00S04034.sslabel +++|# 04035 M00S04035.sslabel +++| 04036 M00S04036.sslabel +++| ARRAY OLDLABEL [0:0] S(LABLEN);; 04037 M00S04037.sslabel +++| ARRAY NEWLABEL [0:0] S(LABLEN);; 04038 M00S04038.sslabel +++| 04039 M00S04039.sslabel +++|# 04040 M00S04040.sslabel +++|* SWITCH TO PROCESS ALL THE *SSLABEL* 04041 M00S04041.sslabel +++|* DIRECTIVES. THE ORDER OF THE SWITCH 04042 M00S04042.sslabel +++|* LABELS IS THE SAME AS THE DIRECTIVE 04043 M00S04043.sslabel +++|* NAMES SET UP IN ARRAY *DIR$NAME* 04044 M00S04044.sslabel +++|* DEFINED IN *COMTLAB*. 04045 M00S04045.sslabel +++|# 04046 M00S04046.sslabel +++| 04047 M00S04047.sslabel +++| SWITCH DIR$ACT # SWITCH TO PROCESS DIRECTIVES # 04048 M00S04048.sslabel +++| ADDCUBE, # ADD CUBES TO A FAMILY OR POOL # 04049 M00S04049.sslabel +++| ADDCSU, # ADD A *SM* TO FAMILY CATALOG # 04050 M00S04050.sslabel +++| ADDMSC, # ADD CARTRIDGES TO FAMILY OR POOL 04051 M00S04051.sslabel +++| # 04052 M00S04052.sslabel +++| FIXVSN, # FIX A CARTRIDGE VSN # 04053 M00S04053.sslabel +++| FLAGFRE, # TURN FREE FLAG ON OR OFF # 04054 M00S04054.sslabel +++| FLAGMSC, # TURN A FLAG ON OR OFF # 04055 M00S04055.sslabel +++| RMVCSU, # REMOVE A *SM* FROM FAMILY CATALOG 04056 M00S04056.sslabel +++| # 04057 M00S04057.sslabel +++| RMVCUBE, # REMOVE A CUBE FROM A FAMILY OR 04058 M00S04058.sslabel +++| POOL # 04059 M00S04059.sslabel +++| RMVMSC, # REMOVE CARTRIDGES FROM FAMILY OR 04060 M00S04060.sslabel +++| POOL # 04061 M00S04061.sslabel +++| RSTRMSC; # RESTORE A LOST CARTRIDGE # 04062 M00S04062.sslabel +++| 04063 M00S04063.sslabel +++| CONTROL EJECT; 04064 M00S04064.sslabel +++| 04065 M00S04065.sslabel +++|# 04066 M00S04066.sslabel +++|* SET UP THE POINTERS OF THE BASED ARRAYS AND 04067 M00S04067.sslabel +++|* THE ADDRESSES OF THE BUFFERS. 04068 M00S04068.sslabel +++|# 04069 M00S04069.sslabel +++| 04070 M00S04070.sslabel +++| # DRAWER RELATED # 04071 M00S04071.sslabel +++| OLDLABP = LOC(OLDLABEL[0]); 04072 M00S04072.sslabel +++| NEWLABP = LOC(NEWLABEL[0]); 04073 M00S04073.sslabel +++| CMAP$IN[0] = SMMAP; 04074 M00S04074.sslabel +++| 04075 M00S04075.sslabel +++|# 04076 M00S04076.sslabel +++|* INITIALIZE THE FETS, BUFFERS ,TABLES AND 04077 M00S04077.sslabel +++|* THE POINTERS FOR THE CATALOG AND THE MAP 04078 M00S04078.sslabel +++|* ACCESS ROUTINES. 04079 M00S04079.sslabel +++|# 04080 M00S04080.sslabel +++| 04081 M00S04081.sslabel +++| SSINIT; 04082 M00S04082.sslabel +++| READ(SCR$FET[0],NRCL); 04083 M00S04083.sslabel +++| 04084 M00S04084.sslabel +++|# 04085 M00S04085.sslabel +++|* READ EACH DIRECTIVE AREA FROM THE SCRATCH FILE. 04086 M00S04086.sslabel +++|# 04087 M00S04087.sslabel +++| 04088 M00S04088.sslabel +++| REPEAT WHILE RDWSTAT EQ 0 04089 M00S04089.sslabel +++| DO 04090 M00S04090.sslabel +++| BEGIN # PROCESS DIRECTIVES # 04091 M00S04091.sslabel +++| READW(SCR$FET[0],LBARG[0],DIRPRML,RDWSTAT); 04092 M00S04092.sslabel +++| IF RDWSTAT NQ 0 04093 M00S04093.sslabel +++| THEN # EOI REACHED # 04094 M00S04094.sslabel +++| BEGIN 04095 M00S04095.sslabel +++| TEST DUMMY; 04096 M00S04096.sslabel +++| END 04097 M00S04097.sslabel +++| 04098 M00S04098.sslabel +++|# 04099 M00S04099.sslabel +++|* WRITE DIRECTIVE NUMBER AND IMAGE TO OUTPUT FILE. 04100 M00S04100.sslabel +++|# 04101 M00S04101.sslabel +++| 04102 M00S04102.sslabel +++| RPLINE(OUT$FETP,LBARG$DIRN[0],2,5,1); 04103 M00S04103.sslabel +++| RPLINE(OUT$FETP,LBARG$DIRI[0],8,80,0); 04104 M00S04104.sslabel +++| RPSPACE(OUT$FETP,SP"SPACE",1); 04105 M00S04105.sslabel +++| IF LBARG$DIRF[0] 04106 M00S04106.sslabel +++| THEN # CHECK SYNTAX ERROR FLAG # 04107 M00S04107.sslabel +++| BEGIN 04108 M00S04108.sslabel +++| RPLINE(OUT$FETP,"*** SYNTAX ERROR",2,16,0); 04109 M00S04109.sslabel +++| TEST DUMMY; 04110 M00S04110.sslabel +++| END 04111 M00S04111.sslabel +++| 04112 M00S04112.sslabel +++|# 04113 M00S04113.sslabel +++|* IF *FM* IS NOT SPECIFIED, USE THE DEFAULT FAMILY. 04114 M00S04114.sslabel +++|# 04115 M00S04115.sslabel +++| 04116 M00S04116.sslabel +++| IF (LBARG$ZFM[0] EQ 0 AND LBARG$OP[0] NQ "FX") ## 04117 M00S04117.sslabel +++| OR LBARG$ZFM[0] EQ -1 04118 M00S04118.sslabel +++| THEN 04119 M00S04119.sslabel +++| BEGIN 04120 M00S04120.sslabel +++| LBARG$FM[0] = DEF$FAM; 04121 M00S04121.sslabel +++| END 04122 M00S04122.sslabel +++| 04123 M00S04123.sslabel +++| PFP$WRD0[0] = 0; # SET FAMILY AND USER INDEX # 04124 M00S04124.sslabel +++| PFP$FAM[0] = DEF$FAM; 04125 M00S04125.sslabel +++| PFP$UI[0] = DEF$UI; 04126 M00S04126.sslabel +++| PFP$FG1[0] = TRUE; 04127 M00S04127.sslabel +++| PFP$FG4[0] = TRUE; 04128 M00S04128.sslabel +++| SETPFP(PFP); 04129 M00S04129.sslabel +++| IF PFP$STAT[0] NQ 0 04130 M00S04130.sslabel +++| THEN # FAMILY NOT FOUND # 04131 M00S04131.sslabel +++| BEGIN 04132 M00S04132.sslabel +++| LBMSG$LN[0] = MSG1; 04133 M00S04133.sslabel +++| MESSAGE(LBMSG[0],SYSUDF1); 04134 M00S04134.sslabel +++| RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT # 04135 M00S04135.sslabel +++| END 04136 M00S04136.sslabel +++| 04137 M00S04137.sslabel +++|# 04138 M00S04138.sslabel +++|* OPEN SMUMAP. 04139 M00S04139.sslabel +++|# 04140 M00S04140.sslabel +++| 04141 M00S04141.sslabel +++| CMAP$ID[0] = LBARG$SM[0]; # SET UP THE *SM* ID # 04142 M00S04142.sslabel +++| MOPEN(LBARG$SMID[0],CMAP$NAME[0],"RM",MSTAT); 04143 M00S04143.sslabel +++| IF MSTAT EQ S"NOERR" 04144 M00S04144.sslabel +++| THEN 04145 M00S04145.sslabel +++| BEGIN 04146 M00S04146.sslabel +++| LOFPROC(CMAP$NAME[0]); # ADD LFN TO LIST OF FILES # 04147 M00S04147.sslabel +++| END 04148 M00S04148.sslabel +++| 04149 M00S04149.sslabel +++| PFP$UI[0] = DEF$UI + LBARG$SB[0]; 04150 M00S04150.sslabel +++| PFP$FAM[0] = LBARG$FM[0]; 04151 M00S04151.sslabel +++| SETPFP(PFP); 04152 M00S04152.sslabel +++| IF PFP$STAT[0] NQ 0 04153 M00S04153.sslabel +++| AND LBARG$OP[0] NQ "FX" 04154 M00S04154.sslabel +++| THEN # FAMILY NOT FOUND # 04155 M00S04155.sslabel +++| BEGIN 04156 M00S04156.sslabel +++| LBMSG$LN[0] = MSG1; 04157 M00S04157.sslabel +++| MESSAGE(LBMSG[0],SYSUDF1); 04158 M00S04158.sslabel +++| RESTPFP(PFP$ABORT); # RESTORE PFP # 04159 M00S04159.sslabel +++| END 04160 M00S04160.sslabel +++| 04161 M00S04161.sslabel +++|# 04162 M00S04162.sslabel +++|* IF THERE IS ANY ERROR OTHER THAN 04163 M00S04163.sslabel +++|* *FILE ALREADY OPEN*, PROCESS THE 04164 M00S04164.sslabel +++|* ERROR STATUS. 04165 M00S04165.sslabel +++|# 04166 M00S04166.sslabel +++| 04167 M00S04167.sslabel +++| IF MSTAT NQ S"NOERR" AND MSTAT NQ S"FOPEN" 04168 M00S04168.sslabel +++| THEN 04169 M00S04169.sslabel +++| BEGIN 04170 M00S04170.sslabel +++| LBRESP(MSTAT,0); 04171 M00S04171.sslabel +++| TEST DUMMY; 04172 M00S04172.sslabel +++| END 04173 M00S04173.sslabel +++| 04174 M00S04174.sslabel +++|# 04175 M00S04175.sslabel +++|* PROCESS THE DIRECTIVE. 04176 M00S04176.sslabel +++|# 04177 M00S04177.sslabel +++| 04178 M00S04178.sslabel +++| SLOWFOR J = 0 STEP 1 UNTIL 9 04179 M00S04179.sslabel +++| DO 04180 M00S04180.sslabel +++| BEGIN 04181 M00S04181.sslabel +++| IF DIR$NM[J] EQ LBARG$OP[0] 04182 M00S04182.sslabel +++| THEN # FIND MATCHING DIRECTIVE # 04183 M00S04183.sslabel +++| BEGIN 04184 M00S04184.sslabel +++| GOTO DIR$ACT[J]; 04185 M00S04185.sslabel +++| END 04186 M00S04186.sslabel +++| 04187 M00S04187.sslabel +++| END 04188 M00S04188.sslabel +++| 04189 M00S04189.sslabel +++|ADDCUBE: 04190 M00S04190.sslabel +++| LBADCUB; 04191 M00S04191.sslabel +++| TEST DUMMY; 04192 M00S04192.sslabel +++| 04193 M00S04193.sslabel +++|ADDCSU: # ADD *SM* TO FAMILY CATALOG # 04194 M00S04194.sslabel +++| LBADCSU; 04195 M00S04195.sslabel +++| TEST DUMMY; 04196 M00S04196.sslabel +++| 04197 M00S04197.sslabel +++|ADDMSC: # ADD CARTRIDGES TO FAMILY/POOL # 04198 M00S04198.sslabel +++| LBADMSC; 04199 M00S04199.sslabel +++| TEST DUMMY; 04200 M00S04200.sslabel +++| 04201 M00S04201.sslabel +++|FIXVSN: # FIX CARTRIDGE VSN # 04202 M00S04202.sslabel +++| LBFXVSN; 04203 M00S04203.sslabel +++| TEST DUMMY; 04204 M00S04204.sslabel +++| 04205 M00S04205.sslabel +++|FLAGFRE: # TURN FREE FLAG ON OR OFF # 04206 M00S04206.sslabel +++| 04207 M00S04207.sslabel +++|FLAGMSC: # TURN A FLAG ON OR OFF # 04208 M00S04208.sslabel +++| LBFLMSC; 04209 M00S04209.sslabel +++| TEST DUMMY; 04210 M00S04210.sslabel +++| 04211 M00S04211.sslabel +++|RMVCSU: # REMOVE *SM* FROM FAMILY CATALOG # 04212 M00S04212.sslabel +++| LBRMCSU; 04213 M00S04213.sslabel +++| TEST DUMMY; 04214 M00S04214.sslabel +++| 04215 M00S04215.sslabel +++|RMVCUBE: # REMOVE CUBE FROM FAMILY/POOL # 04216 M00S04216.sslabel +++| LBRMCUB; 04217 M00S04217.sslabel +++| TEST DUMMY; 04218 M00S04218.sslabel +++| 04219 M00S04219.sslabel +++|RMVMSC: # REMOVE FAMILY/POOL CARTRIDGES # 04220 M00S04220.sslabel +++| LBRMMSC; 04221 M00S04221.sslabel +++| TEST DUMMY; 04222 M00S04222.sslabel +++| 04223 M00S04223.sslabel +++|RSTRMSC: # RESTORE A LOST CARTRIDGE # 04224 M00S04224.sslabel +++| LBRSMSC; 04225 M00S04225.sslabel +++| TEST DUMMY; 04226 M00S04226.sslabel +++| 04227 M00S04227.sslabel +++| END # PROCESS DIRECTIVES # 04228 M00S04228.sslabel +++| 04229 M00S04229.sslabel +++| RETURN; 04230 M00S04230.sslabel +++| 04231 M00S04231.sslabel +++| END # LBMAIN # 04232 M00S04232.sslabel +++| 04233 M00S04233.sslabel +++| TERM 04234 M00S04234.sslabel +++|PROC LBOPT(ERRFLAG); 04235 M00S04235.sslabel +++|# TITLE LBOPT - TESTS FOR VALID *SSLABEL* DIRECTIVES. # 04236 M00S04236.sslabel +++| 04237 M00S04237.sslabel +++| BEGIN # LBOPT # 04238 M00S04238.sslabel +++| 04239 M00S04239.sslabel +++|# 04240 M00S04240.sslabel +++|** LBOPT - TESTS FOR VALID *SSLABEL* DIRECTIVE OPTIONS. 04241 M00S04241.sslabel +++|* 04242 M00S04242.sslabel +++|* THIS PROCEDURE CHECKS THE *SSLABEL* DIRECTIVE OPTIONS 04243 M00S04243.sslabel +++|* SPECIFIED, AND IF AN INVALID OPTION IS FOUND THE 04244 M00S04244.sslabel +++|* ERROR PROCESSOR IS CALLED WITH THE APPROPRIATE 04245 M00S04245.sslabel +++|* ERROR CODE. 04246 M00S04246.sslabel +++|* 04247 M00S04247.sslabel +++|* PROC LBOPT(ERRFLAG) 04248 M00S04248.sslabel +++|* 04249 M00S04249.sslabel +++|* EXIT ALL THE VALID OPTIONS CHECKED OR A VALID 04250 M00S04250.sslabel +++|* OPTION VIOLATED. 04251 M00S04251.sslabel +++|* ERRFLAG, AN ITEM CONTAINING THE ERROR STATUS. 04252 M00S04252.sslabel +++|* 0, NO ERROR. 04253 M00S04253.sslabel +++|* 1, VALID OPTION VIOLATED. 04254 M00S04254.sslabel +++|* 04255 M00S04255.sslabel +++|* NOTES ALL DIRECTIVE OPTIONS ARE TESTED FOR INVALID VALUES. 04256 M00S04256.sslabel +++|* THE VALID OPTIONS ON *SSLABEL* DIRECTIVE CALLS ARE 04257 M00S04257.sslabel +++|* 1. *OP* MUST BE A LEGAL DIRECTIVE NAME. 04258 M00S04258.sslabel +++|* 2. *N* MUST BE 1 IF *CN* IS SPECIFIED. 04259 M00S04259.sslabel +++|* 3. *CN* MUST BE SPECIFIED WITH *RMVMSC* LOST 04260 M00S04260.sslabel +++|* OPTION. 04261 M00S04261.sslabel +++|* 4. *CN* MAY NOT BE SPECIFIED WHEN ANY *PK* 04262 M00S04262.sslabel +++|* OPTION IS USED. 04263 M00S04263.sslabel +++|* 5. *CN* MAY NOT BE SPECIFIED WITH *ADDCSU*, 04264 M00S04264.sslabel +++|* *RMVCSU*, *ADDCUBE* AND *RMVCUBE* DIRECTIVES. 04265 M00S04265.sslabel +++|* 6. VALID USES OF *PK* ARE 04266 M00S04266.sslabel +++|* OP=AM - PK=D OR PK=P 04267 M00S04267.sslabel +++|* OP=RM - PK=P OR PK=F 04268 M00S04268.sslabel +++|* OP=RB - PK=P OR PK=F OR PK=R 04269 M00S04269.sslabel +++|* PK=P MAY NOT BE SPECIFIED IF PT=P. 04270 M00S04270.sslabel +++|* 7. PT=P CANNOT BE SPECIFIED WHEN OP=AM AND 04271 M00S04271.sslabel +++|* *V* IS SPECIFIED. 04272 M00S04272.sslabel +++|* 8. VALID USES OF *PT* ARE 04273 M00S04273.sslabel +++|* OP=AM - PT=P OR PT=F 04274 M00S04274.sslabel +++|* OP=RM - PT=D OR PT=P 04275 M00S04275.sslabel +++|* OP=AB - PT=P OR PT=F OR PT=R 04276 M00S04276.sslabel +++|* 9. VALID USES OF *D* ARE FOR PK=D, OP=RS OR 04277 M00S04277.sslabel +++|* OP=FX. 04278 M00S04278.sslabel +++|* 10. *GR* MUST BE BETWEEN 1 AND 20 AND IS 04279 M00S04279.sslabel +++|* VALID ONLY WITH OP=AM AND OP=RM. 04280 M00S04280.sslabel +++|* 11. *LS* IS VALID ONLY WITH OP=RM. 04281 M00S04281.sslabel +++|* 12. *SM* MUST BE IN A TO M RANGE. 04282 M00S04282.sslabel +++|* 13. *ON* OR *OF* CAN BE SPECIFIED ONLY FOR OP=IB. 04283 M00S04283.sslabel +++|* 14. *YF* AND *ZF* MUST BOTH BE SPECIFIED IF 04284 M00S04284.sslabel +++|* EITHER IS SPECIFIED. 04285 M00S04285.sslabel +++|* 15. *YF* AND *ZF* CAN BE SPECIFIED ONLY IF BOTH 04286 M00S04286.sslabel +++|* *YI* AND *ZI* ARE SPECIFIED. 04287 M00S04287.sslabel +++|* 16. *YI* AND *YF* MUST BE BETWEEN 0 TO 21. 04288 M00S04288.sslabel +++|* 17. *ZI* AND *ZF* MUST BE BETWEEN 0 TO 15. 04289 M00S04289.sslabel +++|* 18. *YF* MUST BE GREATER THAN OR EQUAL TO 04290 M00S04290.sslabel +++|* *YI* IF BOTH ARE SPECIFIED. 04291 M00S04291.sslabel +++|* 19. *ZF* MUST BE GREATER THAN OR EQUAL TO 04292 M00S04292.sslabel +++|* *ZI* IF BOTH ARE SPECIFIED. 04293 M00S04293.sslabel +++|* 20. *SB* MUST BE FROM 0 TO 7. 04294 M00S04294.sslabel +++|* 21. *B* IS VALID ONLY WITH OP=AB. IT MUST 04295 M00S04295.sslabel +++|* 22. *CC* PARAMETER IS VALID ONLY WITH *AM*, MAY 04296 M00S04296.sslabel +++|* NOT BE USED WITH ANY OTHER OPTIONS, AND CAN 04297 M00S04297.sslabel +++|* ONLY BE EQUAL TO 0 OR 15. 04298 M00S04298.sslabel +++|* BE BETWEEN 0 AND 1931. 04299 M00S04299.sslabel +++|* ANY VIOLATION OF THE VALID OPTIONS CAUSES A 04300 M00S04300.sslabel +++|* MESSAGE TO BE PRINTED ON THE REPORT FILE AND 04301 M00S04301.sslabel +++|* IN THE DAYFILE AND AN ERROR STATUS IS RETURNED 04302 M00S04302.sslabel +++|* TO THE CALLING PROCEDURE. PROC *LBERR* DOES 04303 M00S04303.sslabel +++|* ALL THE ERROR PROCESSING. 04304 M00S04304.sslabel +++|# 04305 M00S04305.sslabel +++| 04306 M00S04306.sslabel +++| ITEM ERRFLAG I; # ERROR STATUS # 04307 M00S04307.sslabel +++| 04308 M00S04308.sslabel +++|# 04309 M00S04309.sslabel +++|**** PROC LBOPT - XREF LIST BEGIN. 04310 M00S04310.sslabel +++|# 04311 M00S04311.sslabel +++| 04312 M00S04312.sslabel +++| XREF 04313 M00S04313.sslabel +++| BEGIN 04314 M00S04314.sslabel +++| PROC LBERR; # SSLABEL ERROR PROCESSOR # 04315 M00S04315.sslabel +++| END 04316 M00S04316.sslabel +++| 04317 M00S04317.sslabel +++|# 04318 M00S04318.sslabel +++|**** PROC LBOPT - XREF LIST END. 04319 M00S04319.sslabel +++|# 04320 M00S04320.sslabel +++| 04321 M00S04321.sslabel +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS # 04322 M00S04322.sslabel +++|*CALL COMBFAS 04323 M00S04323.sslabel +++|*CALL COMTERR 04324 M00S04324.sslabel +++|*CALL COMTLAB 04325 M00S04325.sslabel +++|*CALL COMTLBP 04326 M00S04326.sslabel +++| 04327 M00S04327.sslabel +++| ITEM FOUND B; # SEARCH FLAG # 04328 M00S04328.sslabel +++| ITEM I I; # LOOP VARIABLE # 04329 M00S04329.sslabel +++| 04330 M00S04330.sslabel +++| CONTROL EJECT; 04331 M00S04331.sslabel +++| 04332 M00S04332.sslabel +++| ERRFLAG = 0; 04333 M00S04333.sslabel +++| 04334 M00S04334.sslabel +++|# 04335 M00S04335.sslabel +++|* TEST SSLABEL DIRECTIVE OPTIONS AND CALL LBERR WITH APPROPRIATE 04336 M00S04336.sslabel +++|* ERROR CODE IF ERRORS ARE FOUND. 04337 M00S04337.sslabel +++|* CHECK FOR A LEGAL DIRECTIVE NAME. 04338 M00S04338.sslabel +++|# 04339 M00S04339.sslabel +++| 04340 M00S04340.sslabel +++| FOUND = FALSE; 04341 M00S04341.sslabel +++| SLOWFOR I = 0 STEP 1 UNTIL 9 04342 M00S04342.sslabel +++| DO 04343 M00S04343.sslabel +++| BEGIN 04344 M00S04344.sslabel +++| IF LBARG$OP[0] EQ DIR$NM[I] 04345 M00S04345.sslabel +++| THEN 04346 M00S04346.sslabel +++| BEGIN 04347 M00S04347.sslabel +++| FOUND = TRUE; # LEGAL DIRECTIVE NAME # 04348 M00S04348.sslabel +++| END 04349 M00S04349.sslabel +++| 04350 M00S04350.sslabel +++| END 04351 M00S04351.sslabel +++| 04352 M00S04352.sslabel +++| IF NOT FOUND 04353 M00S04353.sslabel +++| THEN 04354 M00S04354.sslabel +++| BEGIN 04355 M00S04355.sslabel +++| ERRCODE = S"ILL$DIRCTV"; # "ILLEGAL DIRECTIVE" # 04356 M00S04356.sslabel +++| LBERR(ERRCODE); 04357 M00S04357.sslabel +++| ERRFLAG = 1; 04358 M00S04358.sslabel +++| RETURN; 04359 M00S04359.sslabel +++| END 04360 M00S04360.sslabel +++| 04361 M00S04361.sslabel +++|# 04362 M00S04362.sslabel +++|* CHECK IF *N* HAS A LEGAL VALUE. 04363 M00S04363.sslabel +++|# 04364 M00S04364.sslabel +++| 04365 M00S04365.sslabel +++| IF LBARG$N[0] LS 1 OR LBARG$N[0] GR 100 04366 M00S04366.sslabel +++| THEN 04367 M00S04367.sslabel +++| BEGIN 04368 M00S04368.sslabel +++| ERRCODE = S"ILL$N"; # "ILLEGAL N" # 04369 M00S04369.sslabel +++| LBERR(ERRCODE); 04370 M00S04370.sslabel +++| ERRFLAG = 1; 04371 M00S04371.sslabel +++| RETURN; 04372 M00S04372.sslabel +++| END 04373 M00S04373.sslabel +++| 04374 M00S04374.sslabel +++|# 04375 M00S04375.sslabel +++|* CHECK FOR A LEGAL VALUE OF *PK*. 04376 M00S04376.sslabel +++|# 04377 M00S04377.sslabel +++| 04378 M00S04378.sslabel +++| IF LBARG$PK[0] NQ "P" ## 04379 M00S04379.sslabel +++| AND LBARG$PK[0] NQ "D" ## 04380 M00S04380.sslabel +++| AND LBARG$PK[0] NQ "F" ## 04381 M00S04381.sslabel +++| AND LBARG$PK[0] NQ "R" ## 04382 M00S04382.sslabel +++| AND LBARG$PK[0] NQ 0 04383 M00S04383.sslabel +++| THEN 04384 M00S04384.sslabel +++| BEGIN
Proceed to Part 2