COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "FAILSA"
C00012 ENDMK
C⊗;
BEGIN "FAILSA"
REQUIRE "[][]" DELIMITERS;
DEFINE #=[COMMENT],RH(A)=[((A) LAND '777777)], LH(A)=[((A) LSH -18)];
DEFINE CRLF=[('15&'12)],CH!ALT=['175];
# SAIL PROGRAM TO READ FAILSAFE TAPES, OPTIONALLY WRITING FILES TO DISK;

INTEGER MTACHAN,MTACNT,MTABC,MTAEOF,STATUS,T;
INTEGER DSKCHAN,DSKCNT,DSKBC,DSKEOF;
INTEGER W0,W1,W2,W3,W4,RBCNT,RBPPN,COMMAND,SKIPPING;
EXTERNAL INTEGER !SKIP!;
STRING RBNAM,RBEXT,FILNAM;

STRING PROCEDURE DAYTIME(INTEGER W3); BEGIN "DAYTIME"
INTEGER T;
RETURN(" AT "&CVS((T←W3 LSH -15)%3600)&":"&CVS((T%60)MOD 60)&":"&CVS(T MOD 60)&
    " ON 19"&CVS((T←W3 LAND '77777)%(12*31)+64)&" "&
      (CASE (T%31)MOD 12 OF
        ("JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP","OCT","NOV","DEC"))&
    " "&CVS((T MOD 31)+1));
END "DAYTIME";

PROCEDURE CHKDSK; BEGIN "CHKDSK"
IF DSKCHAN=-1 THEN RETURN;
PRINT(CRLF,"No EOF on tape when control block encountered.",CRLF,
    FILNAM," closed.");
RELEASE(DSKCHAN); DSKCHAN←-1; SKIPPING←TRUE END "CHKDSK";

SIMPLE PROCEDURE DECRW0; W0←W0-1;
SIMPLE PROCEDURE DECRRBCNT; RBCNT←RBCNT-1;

WHILE TRUE DO BEGIN "MAIN LOOP"
DSKCHAN←-1; SETFORMAT(-2,0);
OPEN(MTACHAN←GETCHAN,"FAILSA",'10,('1001 LSH 18)+5,0,MTACNT,MTABC,MTAEOF←0);
IF MTAEOF THEN CALL(0,"EXIT");
STATUS←GETSTS(MTACHAN);
SETSTS(MTACHAN,STATUS LOR '600);	# SET 800 BPI;
TTYUP(TRUE);				# CONVERT TTY TO UPPER CASE AUTOMATICALLY;

WHILE TRUE DO BEGIN "COMMAND LOOP"
PRINT(CRLF,"*"); COMMAND←INCHRW;
IF COMMAND="A" OR COMMAND="B" OR COMMAND="F" OR COMMAND="R" OR COMMAND="T"
  OR COMMAND="U" OR COMMAND="W"
THEN BEGIN
	MTAPE(MTACHAN,COMMAND);	# ISSUE MAIN COMMAND;
	MTAPE(MTACHAN,NULL);		# WAIT FOR IT TO FINISH;
	IF COMMAND="A" OR COMMAND="B" OR COMMAND="T"
	THEN CLOSE(MTACHAN);		# RESET EOF BIT FOR 'FILE' OPS;
	CONTINUE "COMMAND LOOP"
   END;
IF COMMAND="8" THEN BEGIN
  SETSTS(MTACHAN,(GETSTS(MTACHAN) LAND LNOT '600) LOR '600); CONTINUE "COMMAND LOOP" END;
IF COMMAND="5" THEN BEGIN
  SETSTS(MTACHAN,(GETSTS(MTACHAN) LAND LNOT '600) LOR '400); CONTINUE "COMMAND LOOP" END;
IF COMMAND="2" THEN BEGIN
  SETSTS(MTACHAN,(GETSTS(MTACHAN) LAND LNOT '600) LOR '200); CONTINUE "COMMAND LOOP" END;
IF COMMAND=CH!ALT THEN BEGIN "FILE PROCESSING"
W0←WORDIN(MTACHAN);
W1←WORDIN(MTACHAN);
W2←WORDIN(MTACHAN);
W3←WORDIN(MTACHAN);
W4←WORDIN(MTACHAN);
IF RH(W0)=4 AND W1=CVSIX("*FAILS") AND LH(W2)=LH(CVSIX("AFE")) AND LH(W4)=1
  AND RH(W4)=2
THEN BEGIN "TAPE HEADER"
  PRINT(CRLF,
    "FAILSAFE tape recorded by version ",CVOS(LH(W0)),DAYTIME(W3),
    "  TAPE SEQ # ",RH(W2))
  END "TAPE HEADER"
ELSE BEGIN
  PRINT(CRLF,"This does not look like a FAILSAFE tape.",
	CRLF,"Try a positioning command.");
  CONTINUE "COMMAND LOOP" END;
WHILE TRUE DO BEGIN "FILE LOOP"
  W0←WORDIN(MTACHAN); IF MTAEOF THEN BEGIN
    PRINT(CRLF,"EOF"); IF DSKCHAN>0 THEN RELEASE(DSKCHAN); DSKCHAN←-1; SKIPPING←TRUE;
    CLOSE(MTACHAN); MTAEOF←0; CONTINUE "FILE LOOP" END;
  IF '10000>LH(W0)>0
  THEN BEGIN "HEADER/TRAILER RECORD"
    CHKDSK;
    W1←WORDIN(MTACHAN); DECRW0;
    W2←WORDIN(MTACHAN); DECRW0;
    W3←WORDIN(MTACHAN); DECRW0;
    W4←WORDIN(MTACHAN); DECRW0;
    PRINT(CRLF,IF RH(W2)<'100 THEN "Header" ELSE "Trailer"," record ",DAYTIME(W3));
    W0←RH(W0);			# USE CONTINUATION RECORD CODE TO FLUSH REST OF RECORD;
    END "HEADER/TRAILER RECORD"
  ELSE IF LH(W0)='777777
  THEN BEGIN "DIRECTORY RECORD"
    CHKDSK;
    WORDIN(MTACHAN); DECRW0;	# FILE STRUCTURE NAME;
    RBCNT←WORDIN(MTACHAN); DECRW0;	# COUNT OF RETRIEVAL WORDS;
    RBPPN←WORDIN(MTACHAN); DECRRBCNT; DECRW0;
    RBNAM←CVXSTR(WORDIN(MTACHAN)); DECRRBCNT; DECRW0;
    RBEXT←CVXSTR(WORDIN(MTACHAN))[1 FOR 3]; DECRRBCNT; DECRW0;
    WHILE RBCNT>0 DO BEGIN WORDIN(MTACHAN); DECRRBCNT; DECRW0 END; # SKIP REST;
    PRINT(CRLF,RBNAM,".",RBEXT,"[",CVOS(LH(RBPPN)),",",CVOS(RH(RBPPN)),"]?");
    W0←RH(W0); 		# WHEN DONE, WE WILL USE CONTINUATION RECORD CODE TO
			  SKIP OR COPY REST OF THIS RECORD;
    COMMAND←INCHRW;
    IF COMMAND="Y"
    THEN BEGIN "WANT THIS FILE"
      PRINT(CRLF,"Type <cr> for same name on this area, or new file name:");
      FILNAM←INCHWL; IF !SKIP!=CH!ALT THEN CONTINUE "COMMAND LOOP";
      IF LENGTH(FILNAM)=0 THEN FILNAM←RBNAM&"."&RBEXT;
      OPEN(DSKCHAN←GETCHAN,"DSK",'10,0,19,DSKCNT,DSKBC,DSKEOF←0);
      ENTER(DSKCHAN,FILNAM,DSKEOF);
      SKIPPING←FALSE;
      END "WANT THIS FILE"	# NOTE THAT IN GENERAL WE FALL INTO CONTINUTAION
				  RECORD CODE;
    ELSE IF COMMAND=CH!ALT THEN CONTINUE "COMMAND LOOP"
    ELSE SKIPPING←TRUE END "DIRECTORY RECORD";

  IF LH(W0)=0 AND W0>0
  THEN BEGIN "CONTINUATION RECORD"
    IF SKIPPING
    THEN FOR W0←W0-1 STEP -1 UNTIL 0 DO WORDIN(MTACHAN)
    ELSE IF DSKCHAN=-1
    THEN BEGIN
      PRINT(CRLF,"Unexpected continuation record, control word is ",CVOS(W0));
      CONTINUE "MAIN LOOP" END
    ELSE INOUT(MTACHAN,DSKCHAN,W0) END "CONTINUATION RECORD";
END "FILE LOOP";
END "FILE PROCESSING";

PRINT("
Commands are
    A	advance one file
    B	backspace one file
    F	advance one record
    R	backspace one record
    T	advance to end of tape
    U	rewind and unload
    W	rewind
    8	set 800 bpi (default)
    5	set 556 bpi
    2	set 200 bpi
  <alt>	begin file processing");
END "COMMAND LOOP";
END "MAIN LOOP";
END "FAILSA"