	PROGRAM DISK
C
	BYTE STRING(82),FILNAM(16),OLDFIL(16),ASN(4)
	DIMENSION IFILE(4)
C
	CALL GTLIN(STRING,"100052)	! 100052 = "*"<200>
C
	IREAD=INDEX(STRING,'/R')
	IWARN=INDEX(STRING,'/W')
	IFATL=INDEX(STRING,'/F')
	ICOMMA=INDEX(STRING,',')
	ISLASH=INDEX(STRING,'/')
	IEQUAL=INDEX(STRING,'=')
	IEND=MAX0(ICOMMA,ISLASH,IEQUAL)
	IF (ICOMMA.NE.0.AND.ICOMMA.LT.IEND) IEND=ICOMMA
	IF (ISLASH.NE.0.AND.ISLASH.LT.IEND) IEND=ISLASH
	IF (IEQUAL.NE.0.AND.IEQUAL.LT.IEND) IEND=IEQUAL
	IEND=IEND-1
	IF (IEND.LT.0) IEND=LEN(STRING)
	IF (IEND.EQ.0) CALL STOP('No file name')
C
	DO 10, I=1,IEND
	  FILNAM(I)=STRING(I)
 10	CONTINUE
C
	CALL SCOPY('JM',ASN)
	IF (ICOMMA.EQ.0) GOTO 30
	  DO 20, I=1,3
	    ASN(I)=STRING(ICOMMA+I)
	    IF (ASN(I).EQ.'=') ASN(I)=0
	    IF (ASN(I).EQ.'/') ASN(I)=0
 20	  CONTINUE
	  ASN(4)=0
C	ENDIF
C
 30	IF (IEQUAL.EQ.0) GOTO 50
	  IUNIT=STRING(IEQUAL+1)-'0'
	  IF (LOGDSK(IUNIT,IFILE,ISIZE,IWRLOK,IAVAIL).LT.0)
	*   CALL STOP('Cannot read LD tables')
C	  ENDIF
	  IF (IFILE(1).EQ.0) GOTO 40
	    CALL SCOPY('LD0 is already allocated to ',STRING)
	    STRING(3)=STRING(3)+IUNIT
	    L=LEN(STRING)+1
	    CALL FCVTRX(IFILE,STRING(L))
	    IF (IFATL.NE.0) CALL STOP(STRING)
	    IF (IWARN.NE.0) CALL WARN(STRING)
	    IF (IWARN.EQ.0) CALL CONFRM(STRING,FILNAM)
C	  ENDIF
 40	  GOTO 70
C	ELSE
 50	  DO 60, IUNIT=0,7
	    IF (LOGDSK(IUNIT+0,IFILE,ISIZE,IWRLOK,IAVAIL).LT.0)
	*     CALL STOP('Cannot read LD tables')
C	    ENDIF
	    IF (IFILE(1).EQ.0) GOTO 70
 60	  CONTINUE
	  CALL STOP('No free LD unit available')
C	ENDIF
C
 70	CALL SCOPY('.MOUNT',STRING)
	IF (IREAD.NE.0) CALL CONCAT(STRING,'/NOWRITE',STRING)
	CALL CONCAT(STRING,' LD0 ',STRING)
	L=LEN(STRING)-1
	STRING(L)=STRING(L)+IUNIT
	CALL CONCAT(STRING,FILNAM,STRING)
	CALL CONCAT(STRING,' ',STRING)
	CALL CONCAT(STRING,ASN,STRING)
	CALL INFO(STRING)
C
	CALL SETCMD(STRING(2))
	CALL IPOKE("44,IPEEK("44).OR."40)
	CALL EXIT
	END
C
C
C
	SUBROUTINE STOP(S)
	BYTE S(1),E
	CALL PUTSTR(7,'?DISK-F-','$',E)
	CALL PUTSTR(7,S,'+',E)
	CALL IPOKEB("53,IPEEKB("53).OR."20)
	CALL EXIT
	END
C
C
C
	SUBROUTINE WARN(S)
	BYTE S(1),E
	CALL PUTSTR(7,'?DISK-W-','$',E)
	CALL PUTSTR(7,S,'+',E)
	CALL IPOKEB("53,IPEEKB("53).OR."2)
	RETURN
	END
C
C
C
	SUBROUTINE CONFRM(S,F)
	BYTE X(82),S(1),F(1),E
	CALL PUTSTR(7,'?DISK-I-','$',E)
	CALL PUTSTR(7,S,'+',E)
	CALL SCOPY('        Change to ',X)
	CALL CONCAT(X,F,X)
	CALL CONCAT(X,'? ',X)
	CALL PUTSTR(7,X,'$',E)
	CALL GETSTR(5,X,80,E)
	IF (X(1).EQ.'Y'.OR.X(1).EQ.'y') RETURN
	CALL EXIT
	END
C
C
C
	SUBROUTINE INFO(S)
	BYTE S(1),E
	CALL PUTSTR(7,'?DISK-I-Passing command to KMON',' ',E)
	CALL PUTSTR(7,S,' ',E)
	RETURN
	END
