!* 
!* 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