home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / SIMTEL / CPMUG / CPMUG049.ARK / SCOPY.FOR < prev    next >
Text File  |  1984-04-29  |  2KB  |  72 lines
  1.     PROGRAM SCOPY
  2. C Written by Tim Prince, June 1979
  3. C using Microsoft FORTRAN
  4. C READLB.Z80 accesses physical sectors using MCOS call
  5. C Examine disk B by physical sectors, with ASCII viewing
  6. C Optional copy to MCOS file on disk A
  7.     INTEGER*1 BUF,STATUS,WQ,YES,TILDE,BLANK,CH
  8.     INTEGER*1 LF,CR,TAB
  9.     DIMENSION NAME(6),BUF(128)
  10.     DATA LF/Z'0A'/,CR/Z'0D'/,TAB/Z'09'/
  11.     DATA YES/'Y'/,BLANK/' '/,TILDE/'~'/
  12.     DATA NAME/'SC','OP','YO',' ','OU','T '/
  13.     WRITE(3,10)
  14. 10    FORMAT(1X,'Mount disk to be examined (which need not be'
  15.      &/1X,'an MCOS disk) on drive B, and an MCOS disk with file'
  16.      &/1X,'space available on drive A.  Choose output file'/
  17.      &1X,'2 character code:')
  18.     READ(3,20)NAME(4)
  19. 20    FORMAT(A2)
  20.     CALL OPEN(6,NAME,1)
  21.     WRITE(3,25)
  22. 25    FORMAT(1X,'Enter negative start block to stop')
  23.     DO 600 IT=1,9999
  24.     WRITE(3,30)
  25. 30    FORMAT(1X,'Starting physical block number (0-2001) ?')
  26.     READ(3,35)NBLOK
  27. 35    FORMAT(I4)
  28.     IF(NBLOK.LT.0)STOP
  29.     WRITE(3,40)
  30. 40    FORMAT(1X,'Interleave (4 for MCOS) ?')
  31.     READ(3,45)INTRLV
  32. 45    FORMAT(I1)
  33.     WRITE(3,50)
  34. 50    FORMAT(1X,'Number of sectors to be read?')
  35.     READ(3,35)NSECT
  36.     WRITE(3,60)
  37. 60    FORMAT(1X,'Do you want them written on disk A (Y/N) ?')
  38.     READ(3,70)WQ
  39. 70    FORMAT(A1)
  40. C Call Z80 routines to read a sector and copy buffer to BUF
  41.     LBLOK=(NSECT-1)*INTRLV+NBLOK
  42.     DO 200 NB=NBLOK,LBLOK,INTRLV
  43.     WRITE(3,95)NB
  44. 95    FORMAT(1X,'Block',I5)
  45.     CALL READLB(NB,BUF,STATUS)
  46.     IS1=STATUS+1
  47.     GOTO (150,110,120,130),IS1
  48. 110    WRITE(3,115)
  49. 115    FORMAT(1X,'I/O error')
  50.     GOTO 140
  51. 120    WRITE(3,125)
  52. 125    FORMAT(1X,'Illegal request')
  53.     GO TO 140
  54. 130    WRITE(3,135)NB
  55. 135    FORMAT(1X,'Block number',I5,' illegal')
  56. 140    WQ='N'
  57. 150    CONTINUE
  58. C Change uneditable chars to ~
  59.     DO 180 I=1,128
  60.     CH=BUF(I)
  61.     IF(CH.GT.TILDE.OR.(CH.LT.BLANK.AND.
  62.      &(CH.NE.CR.OR.BUF(I+1).NE.LF).AND.CH.NE.LF.AND.
  63.      &CH.NE.TAB))BUF(I)=TILDE
  64. 180    CONTINUE
  65.     WRITE(3,90)BUF
  66. 90    FORMAT(1X,32A1)
  67.     IF(WQ.EQ.YES)WRITE(6)BUF
  68. 200    CONTINUE
  69. 600    CONTINUE
  70.     STOP
  71.     END
  72.