!* !* TAPE PAIRS LIST CREATION AND MAINTENANCE !* RECORDFORMAT RECF(STRING (7)TAPE1,TAPE2,INTEGER LINK) CONSTINTEGER MAX RECS=1000 OWNRECORDARRAYFORMAT RECSF(1:MAX RECS)(RECF) OWNRECORDARRAYNAME RECS(RECF) OWNINTEGERNAME FREE,PAIRS OWNINTEGER FSYS CONSTSTRINGNAME DATE=X'80C0003F',TIME=X'80C0004B' ! ! SYSTEMROUTINESPEC MOVE(INTEGER L,F,T) EXTERNALROUTINESPEC PROMPT(STRING (15) S) EXTERNALROUTINESPEC GET AV FSYS(INTEGERNAME N,INTEGERARRAYNAME A) EXTERNALINTEGERFNSPEC DCONNECT(STRING (6)USER,STRING (11)FILE, C INTEGER FSYS,MODE,APF,INTEGERNAME SEG,GAP) EXTERNALINTEGERFNSPEC DDISCONNECT(STRING (6)USER,STRING (11)FILE, C INTEGER FSYS,D) EXTERNALSTRINGFNSPEC DERRS(INTEGER FLAG) EXTERNALINTEGERFNSPEC NWFILEAD(STRING (15) F,INTEGER PGS) EXTERNALROUTINESPEC DEFINE(STRING (255) S) EXTERNALROUTINESPEC RSTRG(STRINGNAME S) EXTERNALROUTINESPEC DISCONNECT(STRING (255) S) EXTERNALINTEGERFNSPEC EXIST(STRING (31) F) EXTERNALINTEGERFNSPEC WRFILEAD(STRING (15) F) ! !*********************************************************************** ! INTEGERFN CONNECT AND MAP INTEGER CAD,NA,FLAG,I,SEG,GAP INTEGERARRAY A(0:63) CAD=0 GET AV FSYS(NA,A) CYCLE I=0,1,NA-1 FSYS=A(I) SEG=0; GAP=0 FLAG=DCONNECT("VOLUMS","TAPEPAIRS",FSYS,3,0,SEG,GAP) UNLESS FLAG=0 OR FLAG=32 START PRINTSTRING("CONNECT VOLUMS.TAPEPAIRS FAILS - ".DERRS(FLAG)) NEWLINE RESULT =CAD FINISH EXITIF FLAG=0 REPEAT IF FLAG=32 START PRINTSTRING("VOLUMS.TAPEPAIRS NOT LOCATED") NEWLINE RESULT =CAD FINISH ! SO CONNECTED ON 'FSYS' CAD=SEG<<18 FREE==INTEGER(CAD+32) PAIRS==INTEGER(CAD+36) RECS==ARRAY(CAD+40,RECSF) RESULT =CAD END ; ! CONNECT AND MAP ! !*********************************************************************** ! ROUTINE DISCONNECT PAIRS INTEGER FLAG FLAG=DDISCONNECT("VOLUMS","TAPEPAIRS",FSYS,0) UNLESS FLAG=0 START PRINTSTRING("DISCONNECT VOLUMS.TAPEPAIRS FAILS - ".DERRS(FLAG)) NEWLINE FINISH END ; ! DISCONNECT PAIRS ! !*********************************************************************** ! INTEGERFN FIND(STRING (6) TAPE) INTEGER LINK RECORDNAME REC(RECF) LINK=PAIRS WHILE LINK#0 CYCLE REC==RECS(LINK) IF REC_TAPE1=TAPE OR REC_TAPE2=TAPE THENEXIT LINK=REC_LINK REPEAT RESULT =LINK END ; ! FN FIND ! !*********************************************************************** ! EXTERNALROUTINE GET PAIR(STRING (255) TAPE) INTEGER FLAG RECORDNAME REC(RECF) UNLESS LENGTH(TAPE)=6 START PRINTSTRING("FORM IS GET PAIR(TAPE ID) ") RETURN FINISH ! FLAG=CONNECT AND MAP RETURNIF FLAG=0 FLAG=FIND(TAPE) IF FLAG=0 START PRINTSTRING(TAPE." NOT FOUND IN LIST") FINISHELSESTART REC==RECS(FLAG) PRINTSTRING(REC_TAPE1."-".REC_TAPE2) FINISH NEWLINE DISCONNECT PAIRS END ; ! ROUTINE GET RECORD !*********************************************************************** ! ! EXTERNALROUTINE LIST PAIRS(STRING (255) OUTDEV) INTEGER FLAG,LINK,WIDTH,I RECORDNAME REC(RECF) ! UNLESS LENGTH(OUTDEV)>0 START PRINTSTRING("FORM IS LIST PAIRS(OUTDEV) ") RETURN FINISH ! IF OUTDEV=".OUT" THEN WIDTH=72 ELSE WIDTH=120 ! FLAG=CONNECT AND MAP RETURNIF FLAG=0 LINK=PAIRS DEFINE("1,".OUTDEV) SELECTOUTPUT(1) NEWLINE PRINTSTRING("TAPE PAIRS LIST ON ".DATE." AT ".TIME) NEWLINES(2) I=WIDTH WHILE LINK#0 CYCLE REC==RECS(LINK) PRINTSTRING(REC_TAPE1."-".REC_TAPE2." ") I=I-16 IF I<16 THEN NEWLINE AND I=WIDTH LINK=REC_LINK REPEAT NEWLINE PRINTSTRING("END OF LIST") NEWLINE SELECTOUTPUT(0) DISCONNECT PAIRS END ; ! ROUTINE LIST PAIRS ! !*********************************************************************** EXTERNALROUTINE CHECK PAIRS(STRING (255) OUTDEV) EXTERNALINTEGERFNSPEC PSTOI (STRING (63) S) INTEGER FLAG,LINK,WIDTH,I,N1,N2 STRING (6) TAPE1,TAPE2 RECORDNAME REC(RECF) ! UNLESS LENGTH(OUTDEV)>0 START PRINTSTRING("FORM IS CHECK PAIRS(OUTDEV) ") RETURN FINISH ! FLAG=CONNECT AND MAP RETURNIF FLAG=0 LINK=PAIRS DEFINE("1,".OUTDEV) SELECTOUTPUT(1) WHILE LINK#0 CYCLE REC==RECS(LINK) TAPE1 = REC_TAPE1 TAPE2 = REC_TAPE2 N1 = PSTOI(FROMSTRING(TAPE1,4,6)) N2 = PSTOI(FROMSTRING(TAPE2,4,6)) IF N1+1 = N2 THEN START PRINTSTRING(TAPE1."-".TAPE2." OK"); NEWLINE FINISHELSESTART PRINTSTRING(TAPE1." NOT PAIRED PROPERLY WITH ".TAPE2) NEWLINE FINISH LINK=REC_LINK REPEAT SELECTOUTPUT(0) DISCONNECT PAIRS END ; ! ROUTINE CHECK PAIRS ! !*********************************************************************** ! EXTERNALROUTINE REVERSE PAIRS(STRING (255) S) ! ! PRIMARIES BECOME SECONDARIES AND V.V. IN A LOCAL COPY OF LIST ! RECORDNAME REC(RECF) INTEGER CAD,LINK STRING (6) TAPE ! IF EXIST("TAPEPAIRS")=0 START PRINTSTRING("'TAPEPAIRS' DOES NOT EXIST ") RETURN FINISH CAD=WRFILEAD("TAPEPAIRS") RETURNIF CAD=0 ! FREE==INTEGER(CAD+32) PAIRS==INTEGER(CAD+36) RECS==ARRAY(CAD+40,RECSF) ! LINK=PAIRS WHILE LINK#0 CYCLE REC==RECS(LINK) TAPE=REC_TAPE2 REC_TAPE2=REC_TAPE1 REC_TAPE1=TAPE LINK=REC_LINK REPEAT PRINTSTRING("DONE") NEWLINE DISCONNECT("TAPEPAIRS") END ; ! ROUTINE REVERSE PAIRS ! !*********************************************************************** ! EXTERNALROUTINE COPY PAIRSLIST(STRING (255) S) ! ! COPIES PAIRSLIST TO 'TAPEPAIRS' IN THIS PROCESS ! INTEGER CADFROM,CADTO,PGS ! IF EXIST("TAPEPAIRS")#0 START PRINTSTRING("FILE 'TAPEPAIRS' ALREADY EXISTS ") RETURN FINISH ! PGS=(MAX RECS*20+8+32+4095)>>12; ! EPAGES CADTO=NWFILEAD("TAPEPAIRS",PGS) RETURNIF CADTO=0; ! FAILED ! CADFROM=CONNECT AND MAP RETURNIF CADFROM=0 ! MOVE(INTEGER(CADFROM+8),CADFROM,CADTO) PRINTSTRING("COPY IN 'TAPEPAIRS' ") DISCONNECT PAIRS DISCONNECT("TAPEPAIRS") END ; ! ROUTINE COPY PAIRSLIST ! ENDOFFILE