C C P M R T . F O R : TRANSFER CP/M - SD FLOPPIES TO RT-11 C C C H.P. STOEHREL C C *** V1 *** 3-DEC-81 : ONLY OUTPUT OF SINGLE RECORDS C *** V2 *** 4-DEC-81 : ADDED DIRECTORY LISTING C *** V3 *** 8-DEC-81 : PACKED ASCII 2 CHARS/WRD. C *** V4 *** 9-DEC-81 : DELETE FILE/ZERO DIRECT. C *** V5 *** 12-DEC-81 : EXTENT HANDLING C *** V6 *** 17-DEC-81 : WRITE FUNCTION C *** V7 *** 22-DEC-81 : CORR. C *** V8 *** 3-MAR-82 : CORR. FUNC. 3 C *** V9 *** 26-MAR-82 : SHIFT-FUNC. C *** V10 *** 1-APR-82 : PUTSTRING C *** V11 *** 2-APR-82 : CORR. C *** V12 *** 6-APR-82 : CORR. C *** V14 *** 25-JUL-84 : CORR. (SEMPERT, KUSTER) C DIMENSION IT(2),IB(1025),NAME(12),IBLK(257),IOB(513) DIMENSION IBI(151),ISLO(65),IDIR(2049),IFCB(33) C INTEGER*2 IUNIT,IERR C BYTE INFILE(16),IODVX,CPMNAM(12) C LOGICAL*1 ICH,MCTRL,PUERR,IBO(151),OPENFL C 2 TYPE 11 11 FORMAT(// *' ---------------------------------------------'/ *' C P M R T . V 1 4 - CP/M TO RT-11 TRANSFER'/ *' ---------------------------------------------'/) 3 TYPE 13 13 FORMAT(/' Die CP/M Single density Floppy ist im Drive Nr.: (0) '$) ACCEPT 14,IUNIT 14 FORMAT (I1) IF (IUNIT.NE.0.AND.IUNIT.NE.1) GO TO 3 CALL INIT (IUNIT,IERR) IF (IERR.NE.0) STOP '?CPMRT-F-LOOKUP Error opening Floppy Disc' C 100 CALL CLOSE (1) ! JUST IN CASE ..... TYPE 101 101 FORMAT(/ *' 0 = List Directory'/ *' 1 = Transfer File from CP/M to RT11'/ *' 2 = Transfer File from RT11 to CP/M'/ *' 3 = Delete CP/M File'/ *' 4 = Zero CP/M Directory'//' CPMRT Command: (0) '$) ACCEPT 1,IAN 1 FORMAT(I7) IF (IAN.GT.4.OR.IAN.LT.0) GOTO 100 GOTO (1000,2000,3000,4000,5000),IAN+1 C C------------------------------------------------------------------ C 1000 CALL CPDIR (1,NAME,IRNUM,IDIR,IBLK,ISLO,IFCB) TYPE 11 GOTO 100 C C------------------------------------------------------------------ C C READ FROM CP/M FLOPPY C 2000 CALL CPFI(NAME) ! INPUT CP/M FILENAME C DO 2010 I = 1,12 2010 CPMNAM(I) = NAME(I) CALL CPRTN(INFILE,CPMNAM) C CALL ASSIGN (1,INFILE) IODV=1 MCTRL=' ' ! FORM OUTPUT CTRL C 2200 CALL CPDIR (2,NAME,IRNUM,IDIR,IBLK,ISLO,IFCB) C IF(IRNUM.EQ.-1) GOTO 100 C C>>>>>>> C TYPE 2501,IRNUM,(IBLK(L),L=1,256) C2501 FORMAT(I7,/,18I4) C>>>>>>> C 2600 DO 2604 M=1,150 2604 IBO(M)=0 L=0 C DO 2400 NR=1,256 IF(IBLK(NR).EQ.0) GOTO 2400 CALL CPRD(IB,NR) C DO 2550 J=1,1024 C ICH=IB(J).AND."177 ! FORM 7-BIT ASCII IF (ICH.EQ."15) GOTO 2700 ! CARRIAGE RETURN IF (ICH.EQ."32) GOTO 2800 ! 32(CTR/Z) = EOF IN CP/M IF (ICH.EQ."10.OR.ICH.EQ."11.OR. *ICH.EQ."14) GOTO 2680 ! LEAVE BACKSPACE,TAB & FORM FEED IF (ICH.LT."40) GOTO 2550 ! REMOVE OTHER CONTROL CHARS C 2680 L=L+1 IBO(L)=ICH GOTO 2550 C 2700 CALL PUTSTR (IODV,IBO,MCTRL,PUERR) IF (PUERR.EQ..FALSE.) GOTO 2588 ! FALSE = NO ERROR TYPE 2589 2589 FORMAT(/' ?CPMRT-F-Output error'/) CALL EXIT C 2588 DO 2560 M=1,150 2560 IBO(M)=0 L=0 C 2550 CONTINUE C 2400 CONTINUE C 2800 CALL CLOSE(IODV) TYPE 11 GOTO 100 C C------------------------------------------------------------------ C C WRITE TO CP/M FLOPPY C 3000 OPENFL=.FALSE. IFCTL=0 ! FIRST TIME WRITE CALL CPRTN (INFILE, ' ') CALL ASSIGN (1,INFILE) IODV=1 C CALL CPFI(NAME) ! INPUT CP/M FILENAME C CALL CPDIR (3,NAME,IRNUM,IDIR,IBLK,ISLO,IFCB) IF (IRNUM.EQ.-1) GOTO 100 ! FILE ALREADY EXISTS C C PAUSE 'CPMRT - PRIOR TO READ' IEND=0 C K=0 CCC DO 3106 J=1,150 CCC3106 IBI(J)=0 C CCC3100 READ(1,3011,END=3116,ERR=3990)JEN,(IBI(L),L=1,150) ! READ ONE LINE 3100 READ(1,3011,END=3116,ERR=3990)JEN,(IBI(L),L=1,132) ! READ ONE LINE 3011 FORMAT(Q,150A1) C C>>>>>> C TYPE 3097,(IBI(L),L=1,JEN) C3097 FORMAT(X,150A1) C>>>>>> C DO 3170 J=1,JEN C IF(K.LT.1024) GOTO 3180 C CALL CPWOUT(IB,IDIR,IBLK,ISLO,IFCB, 1 NAME,IFCTL,OPENFL,IERR) ! OUTPUT BUFFER IF (IERR.EQ.1) GOTO 100 IFCTL=1 ! AFTER FIRST WRITE K=0 ! OUTPUT CHAR COUNTER C 3180 K=K+1 CCCC IB(K)=IBI(J)-"20000 ! REMOVE SPACE (A2-FORMAT !) IB(K)=IBI(J) ! REMOVE SPACE (A2-FORMAT !) C C>>>>>> C TYPE 3099,K,IB(K),IB(K) C3099 FORMAT(I5,O8,2X,A1) C>>>>>> C 3170 CONTINUE C IF(K.LT.1024) GOTO 3178 CALL CPWOUT(IB,IDIR,IBLK,ISLO,IFCB,NAME,IFCTL,OPENFL,IERR) ! OUTPUT BUFFER IF (IERR.EQ.1) GOTO 100 IFCTL=1 K=0 ! OUTPUT CHAR COUNTER 3178 K=K+1 IB(K)="15 ! CR C>>>>>> C TYPE 3099,K,IB(K),IB(K) C>>>>>> C IF(K.LT.1024) GOTO 3182 CALL CPWOUT(IB,IDIR,IBLK,ISLO,IFCB,NAME,IFCTL,OPENFL,IERR) ! OUTPUT BUFFER IF (IERR.EQ.1) GOTO 100 IFCTL=1 K=0 ! OUTPUT CHAR COUNTER 3182 K=K+1 IB(K)="12 ! LF C>>>>>> C TYPE 3099,K,IB(K),IB(K) C>>>>>> C GOTO 3100 C 3116 IF(K.LT.1024) GOTO 3186 CALL CPWOUT(IB,IDIR,IBLK,ISLO,IFCB,NAME,IFCTL,OPENFL,IERR) ! OUTPUT BUFFER IF (IERR.EQ.1) GOTO 100 IFCTL=1 K=0 ! OUTPUT CHAR COUNTER 3186 K=K+1 IB(K)="32 ! INSERT CTRL/Z (EOF FOR CP/M) C DO 3220 M=K+1,1024 3220 IB(M)=0 ! PAD BUFFER WITH ZEROS C C>>>>>> C PAUSE ' CPMRT : LAST OUT' C>>>>>> CALL CPWOUT(IB,IDIR,IBLK,ISLO,IFCB,NAME,-1,OPENFL,IERR) ! LAST BUFFER IF (IERR.EQ.1) GOTO 100 C CALL CLOSE(1) C TYPE 11 GOTO 100 C 3990 TYPE 3991 3991 FORMAT(/' ?CPMRT-W-Input file not found'/) GOTO 3000 C C C------------------------------------------------------------------ C C DELETE FILE C 4000 CONTINUE CALL CPFI(NAME) ! INPUT CP/M FILENAME CALL CPDIR (5,NAME,IRNUM,IDIR,IBLK,ISLO,IFCB) TYPE 11 GOTO 100 C C------------------------------------------------------------------ 5000 CONTINUE CALL CPDIR (6,NAME,IRNUM,IDIR,IBLK,ISLO,IFCB) TYPE 11 GOTO 100 C END