File DIALPS.FT (FORTRAN source file)

Directory of image this file is from
This file as a plain text file

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



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search