C	DIALPS.FT, PAGE 1 OF 3.	(10/19/71 - C.M.MOORE, RICE U., HOUSTON)
C
C	COPIES FILES FROM DIAL LINCTAPE 1 TO PS/8 DEVICE SYS:
C
C	DIAL FILES ARE SPECIFIED BY A STARTING BLOCK NUMBER AND LENGTH
C	IN BLOCKS, AVAILABLE FROM THE DIAL INDEX.
C	PS/8 FILES ARE SPECIFIED BY A FILE NAME AND EXTENSION.
C
C	HEADER BLOCKS OF CORE IMAGE FILES (I.E., DIAL BINARY TO PS/8
C	.SV FILES) ARE AUTOMATICALLY CONVERTED FROM DIAL TO PS/8
C	FORMAT.  THESE DIAL BINARY FILES MUST BE SELF-STARTING IN
C	8-MODE, IN ORDER TO START CORRECTLY UNDER THE PS/8 SYSTEM.
C
C	ALL OTHER TYPE FILES (E.G., DATA OR SOURCE FILES) ARE
C	COPIED WITHOUT ALTERATION.
C
	COMMON NSEGS,ICDIF,IADDR,JOBW,KNTRL,
	1 IW1,IW2,IW3,IW4,KDUMY,NWDS,IWD0,IWD1,IBUFF
	DIMENSION KNTRL(2,126),KDUMY(219),IWD0(16),IWD1(16)
	DIMENSION IBUFF(256),NAME(4),IDEV(2)
C
100	CALL CRLF
C	READ NAME OF NEW FILE TO BE CREATED ON SYS:
110	WRITE(1,120)
120	FORMAT('WHEN * APPEARS, TYPE NAME OF NEW PS/8 FILE')
	CALL NAMES(IDEV,NAME,IDEV,NAME)
	IF(NAME)130,110,130
C	READ OCTAL STARTING BLOCK NUMBER OF FILE TO COPY FROM LINCTAPE 1
130	WRITE(1,140)
140	FORMAT('NOW SELECT DIAL FILE:')
	CALL ALPHA('START')
	CALL ALPHA('ING B')
	CALL ALPHA('LOCK ')
	CALL ALPHA('=')
	IBLK1=INTIN(8)
C	READ OCTAL LENGTH OF FILE ON LINCTAPE 1.
	CALL ALPHA('LENGT')
	CALL ALPHA('H IN ')
	CALL ALPHA('BLOCK')
	CALL ALPHA('S =')
	NBLKS=INTIN(8)
C	MAKE A NEW TENTATIVE FILE ON SYS AND CHECK AVAILABLE SPACE
	NB1=MSYS(NAME,LMAX)
	IF(LMAX-NBLKS)150,190,190
C	FILE WON'T FIT ON SYS
150	WRITE(1,160)
160	FORMAT('FILE WILL NOT FIT ON SYS:')
	GO TO 100
C	CHECK FOR .SV FILE
190	IF(NAME(4)-1238)195,300,195
C	COPY FILE BLOCKS
195	DO 200 I=1,NBLKS
	CALL RLINC(1,IBLK1,1,IBUFF,256)
	CALL WSYS(2,NB1,IBUFF)
	NB1=NB1+1
200	IBLK1=IBLK1+1
C	CLOSE (MAKE PERMANENT) NEW FILE ON SYS
220	CALL CSYS(NBLKS)
	GO TO 100
C
C	DIALPS.FT, PAGE 2 OF 3.
C
C	CONVERT .SV FILE HEADER BLOCK FROM DIAL TO PS/8 FORMAT
300	CALL RLINC(1,IBLK1,1,IW1,256)
C	CHECK FOR STARTING ADDRESS
	IF(IW1)304,302,304
302	WRITE(1,303)
303	FORMAT('NO STARTING ADDRESS FOR .SV FILE')
	GO TO 308
C	CHECK THAT DIAL .SV FILE STARTS IN 8-MODE.
304	IF(IW1-2)306,310,306
306	WRITE(1,307)
307	FORMAT('.SV FILE MUST START IN 8-MODE')
308	ICDIF=0
	IADDR=0
	GO TO 312
C	CONVERT HEADER POINTERS
310	ICDIF=IW2+1
	IADDR=IW4
312	JOBW=512
	NSEGS=-NWDS
	DO 320 I=1,126
	DO 320 J=1,2
320	KNTRL(J,I)=0
C	CONVERT FIELD 1 CORE IMAGE POINTERS
	IPS8=1
	DO 400 I=1,15
	IF(IWD1(I))340,400,340
340	KNTRL(1,IPS8)=(I-1)*256
	KNTRL(2,IPS8)=136
	IPS8=IPS8+1
400	CONTINUE
	IF(IWD1(16))420,440,420
420	KNTRL(1,IPS8)=15*256
	KNTRL(2,IPS8)=72
	IPS8=IPS8+1
440	IFLD1=IPS8-1
C	CONVERT FIELD 0 CORE IMAGE POINTERS
	DO 500 I=1,15
	IF(IWD0(I))460,500,460
460	KNTRL(1,IPS8)=(I-1)*256
	KNTRL(2,IPS8)=128
	IPS8=IPS8+1
500	CONTINUE
	IF(IWD0(16))520,600,520
520	KNTRL(1,IPS8)=15*256
	KNTRL(2,IPS8)=64
	IPS8=IPS8+1
600	IFLD0=IPS8-1-IFLD1
	IF(IPS8-1-NWDS)620,700,620
620	WRITE(1,630)
630	FORMAT('BAD .SV FILE HEADER BLOCK')
	GO TO 100
C	WRITE CONVERTED HEADER BLOCK
700	CALL WSYS(2,NB1,NSEGS)
C
C	DIALPS.FT, PAGE 3 OF 3.
C
C	COPY FIELD 1 CORE IMAGE BLOCKS
	IF(IFLD1)1000,1000,800
800	DO 900 I=1,IFLD1
	JBLK1=IBLK1+IFLD0+I
	JB1=NB1+I
	CALL RLINC(1,JBLK1,1,IBUFF,256)
900	CALL WSYS(2,JB1,IBUFF)
C	COPY FIELD 0 CORE IMAGE BLOCKS
1000	IF(IFLD0)220,220,1100
1100	DO 1200 I=1,IFLD0
	JBLK1=IBLK1+I
	JB1=NB1+IFLD1+I
	CALL RLINC(1,JBLK1,1,IBUFF,256)
1200	CALL WSYS(2,JB1,IBUFF)
	GO TO 220
	END