Subject: Re: Dave Mills' Fuzzball

From: "Timothy D. Shoppa x4256" <[email-masked]>
Date: Mon, 6 Feb 1995 11:12:36 -0800 (PST)

Path: almach.caltech.edu!shoppa
From: [email-masked] (Timothy D. Shoppa x4256)
Newsgroups: vmsnet.pdp-11
Subject: Re: Dave Mills' Fuzzball
Summary:  
Date:  6 Feb 1995 11:12 PST  
Distribution: world
Keywords:  
Message-ID: <[email-masked]>
References: <[email-masked]>
Organization: California Institute of Technology
News-Software: VAX/VMS VNEWS 1.41    
 
In article <[email-masked]>, [email-masked] (Phil Budne) writes...
>Fantastic!
> 
>Does anyone have a program to unpack LD's for those of us without
>(working) 11's?
> 
>-phil
 
The most convenient way is to use EXCHANGE under VMS.  Don't have a VAX?
Here's some Fortran code I wrote to unpack logical directories.  It has
quite a few VMS-isms in it (it spawns copies of itself to unpack LD's found
in a LD), but I think you'll figure it out.  It checks the first block
of a file for the string DECRT11A to determine if it is a LD or not,
and just may be fooled by a non-LD file with this string in the same
place.  The output files are exact copies of the files, done block-by-block;
you may find the files unreadable/uneditable on some systems that use a
different end-of-line terminator than RT11.
 
Below my code are some RAD50 subroutines posted by Steve Lionel (of DEC)
to comp.os.vms for those who do not have the RAD50 functions in their
system libraries already.
 
At present, the code prints a listing of the Dates/Times recorded
in the LD, but creates the output files with the current date/time.
An obvious improvement would be to create the output files with the
Date/Time recorded in the LD.
 
A copy of this code is kept at the anonymous ftp site
sunsite.unc.edu in the
 
/pub/academic/computer-science/history/pdp-11/rt/ldtools
 
directory.
 
Tim. ([email-masked])
Kellogg Radiation Lab, Caltech.
 
*** EXTRACT.FOR follows:
 
	program extract
 
C Extract all the files from a RT-11 logical disk.
C When a logical disk is found in a logical disk volume,
C create a new subdirectory and spawn a copy of extract
C to handle the files/LD's in that LD.
 
C It checks the first block
C of a file for the string DECRT11A to determine if it is a LD or not,
C and just may be fooled by a non-LD file with this string in the same
C place.  The output files are exact copies of the RT-11 files, 
C done block-by-block;
C you may find text files unreadable/uneditable on some systems that use a
C different end-of-line terminator than RT11.
 
C Copyright 1994 by Tim Shoppa ([email-masked])
C Redistribution and modification for non-commercial purposes
C is encouraged; just be sure to keep the original Copright/attribution
C in the code.
 
	implicit integer*2 (i-n)
	character*12 fcheck
	byte fcheckb(12)
	equivalence(fcheck,fcheckb)
	character*10 fname
	byte fnameb(10)
	equivalence (fname,fnameb)
	integer*2 itemp(2)
	integer*4 iat,i,j,k,idir,isd0
	character*6 type
	character*80 infile,dirname,outfile
	character*80 line
	integer infilelen,infiledot,dirlen,outfilelen,fnamesp
	integer*2 buffer(0:255)
 
	read(5,666) infile
666	format(a)
 
	type *,infile
 
	open(unit=1,form='unformatted',file=infile,
     1		recordtype='fixed',recl=128,access='direct',
     2		status='old')
 
	infilelen=index(infile,' ')-1
	infiledot=index(infile,'.')
	dirname='[.'//infile(1:infilelen)//']'
	dirname(infiledot+2:infiledot+2)='_'
	dirlen=index(dirname,' ')-1
 
	call lib$spawn('create/dir '//dirname(1:dirlen))
 
	call read1(1,496,fcheckb,12)
 
	if (fcheck.ne.'DECRT11A    ') then
	  type *,'Does not appear to be a RT-11 device'
	  go to 9990
	end if
 
	call read2(1,234,idir0,1)
 
	idir=idir0
 
110	call read2(idir,3,iextra,1)
	iextra=iextra/2
	call read2(idir,4,isd0,1)
	isd=isd0
	iat=5
150	call read2(idir,iat,istat,1)
	if (istat.eq.2048) then
	  call read2(idir,1,idirn,1)
	  if (idirn.eq.0) go to 200
	  idir=idir0+(idirn-1)*2
	  go to 110
	end if
	if (istat.ne.1024.and.istat.ne.-31744) go to 190
	call read2(idir,iat+1,itemp2,2)
	call r50asc(6,itemp2,fnameb(1))
	fname(7:7)='.'
	call read2(idir,iat+3,itemp2,1)
	call r50asc(3,itemp2,fnameb(8))
	call read2(idir,iat+4,ilen,2)
	call read2(idir,iat+6,idat,2)
	idatm=idat/1024
	idatd=(idat-idatm*1024)/32
	idaty=(idat-idatm*1024-idatd*32)+72
 
	fnamesp=index(fname,' ')
	if (fnamesp.eq.0 .or. fnamesp.ge.7) fnamesp=7
	
185	outfile=dirname(1:dirlen)//fname(1:fnamesp-1)//'.'
     1		//fname(8:10)//';2'
 
	open(unit=2,form='unformatted',file=outfile,
     1		recordtype='fixed',recl=128,access='direct',
     2		status='new')
	do i=0,ilen-1
	  call read2(isd+i,0,buffer,256)
	  write(2,rec=i+1) buffer
	end do
	close(2)
 
	type='FILE'
	if (ilen.ge.2) then
	  call read1(isd+1,496,fcheckb,12)
	  if (fcheck.eq.'DECRT11A    ') type='DIR'
	end if
 
189	type *,fname,ilen,isd,idatm,idatd,idaty,'  ',type
 
	if (type(1:3).eq.'DIR') then
	  open(unit=13,file='xxx_xxx.com',status='new',
     1		carriagecontrol='list')
	  write(13,666) '$set def '//dirname
	  write(13,666) '$run disk$user2:[shoppa.billy.dsk]extract'
	  outfile=fname(1:fnamesp-1)//'.'//fname(8:10)
	  outfilelen=index(outfile,' ')-1
	  write(13,666) outfile
	  write(13,666) '$delete '//outfile(1:outfilelen)//';*'
	  close(13)
	  call lib$spawn([email-masked]')
	  call lib$spawn('delete xxx_xxx.com;*')
	end if
 
	isd=isd+ilen
190	iat=iat+iextra+7
	go to 150
 
200	continue
 
9990	continue
	end
 
	subroutine read1(iblock,iword,outbuf,n)
	byte outbuf(0:n-1)
	do i=0,n-1
	  outbuf(i)=ipeek(iblock,iword+i,1)
	end do
	return
	end
 
	subroutine read2(iblock,iword,outbuf,n)
	integer*2 outbuf(0:n-1)
	do i=0,n-1
	  outbuf(i)=ipeek(iblock,iword+i,2)
	end do
	return
	end
 
	function ipeek(iblock,iword,iws)
	logical first
	byte buffer1(0:511)
	integer*2 buffer2(0:255)
	integer*4 buffer4(0:127),i4
	equivalence (buffer1,buffer2)
	equivalence (buffer1,buffer4)
	data first/.true./
 
	if (first) then
	  first=.false.
	  ipblockb=-1
	end if
	
	ipblock=iblock+iword*iws/512
	ipword=mod(iword,512/iws)
 
	if (ipblockb.ne.ipblock) then
	  read(1,rec=ipblock+1) buffer1
	  ipblockb=ipblock
	end if
 
	if (iws.eq.1) then
	  ipeek=buffer1(ipword)
	else if (iws.eq.2) then
	  ipeek=buffer2(ipword)
	else if (iws.eq.4) then
	  ipeek=buffer4(ipword)
	else
	  stop ' illegal word size.'
	end if
 
	return
	end
 
*** end of extract.for

Path: nntp-server.caltech.edu!elroy.jpl.nasa.gov!swrinde!cs.utexas.edu!uunet!decwrl!pa.dec.com!jac.nuo.dec.com!quark.enet.dec.com!lionel
From: [email-masked] (Steve Lionel)
Newsgroups: comp.os.vms,vmsnet.alpha
Subject: Fortran versions of IRAD50, RAD50 and R50ASC routines
Date: 16 Aug 1993 21:00:00 GMT
Organization: Digital Equipment Corporation, Nashua NH
Lines: 238
Distribution: world
Message-ID: <[email-masked]>
Reply-To: [email-masked] (Steve Lionel)
NNTP-Posting-Host: QUARK
X-Newsreader: mxrn 6.18-5
Xref: nntp-server.caltech.edu comp.os.vms:72782 vmsnet.alpha:741

One problem some customers have when migrating VERY old applications from
OpenVMS VAX to OpenVMS AXP is that DEC Fortran for OpenVMS AXP does not
support the PDP-11 Radix-50 feature, which consisted of a "R" constant
notation for DATA initialization and the routines IRAD50, RAD50 and R50ASC.
 
As an aid to migrating such applications, I offer the following Fortran
versions of the Radix-50 routines.  I've tested these as well as compared the
algorithm to that used by the VAX FORTRAN library and I believe they are
compatible with VAX FORTRAN.  There is, however, no replacement for the
"R" constant syntax.  Still, this may be what some people need to get their
applications ported.  Ideally, the application should be rewritten to use
the Fortran-77 CHARACTER type.
 
Feel free to send me mail if you have questions or comments on this code.
 
----- cut here -----
	OPTIONS /CHECK=NOOVERFLOW
	INTEGER*2 FUNCTION IRAD50(ICNT,INPUT,OUTPUT)
	
C+
C 
C ABSTRACT:
C  
C     Fortran version of the IRAD50 function.
C  
C FUNCTIONAL DESCRIPTION:
C 
C     IRAD50 converts ASCII characters to Radix-50 form, storing them as three
C     characters per output 16-bit word.
C
C FORMAL PARAMETERS:
C  
C     ICNT:
C	  Specifies the number of characters of INPUT
C	  to be converted.  INTEGER*2
C      
C     INPUT:
C	  The Hollerith string to be converted, passed
C	  by reference or by descriptor.
C      
C     OUTPUT:
C	  A numeric variable or array element where the
C	  Radix-50 results are stored.
C      
C 
C FUNCTION VALUE:
C 
C     The number of characters converted.  Conversion stops when
C     a non-Radix-50 character is seen; the last converted word will
C     appear to be blank-filled on the left (this is not what one might
C     expect from the documentation, but it is what the VAX implementation
C     does.)
C 
C DESIGN:
C  
C     See section B.3 of the DEC Fortran Language Reference Manual
C     and Appendix F of the DEC Fortran User Manual for OpenVMS VAX
C  
C-
	IMPLICIT NONE
	INCLUDE '($DSCDEF)' ! Descriptor definitions
	STRUCTURE /DSC/	! Descriptor structure
	  INTEGER*2 DSC$W_LENGTH
	  BYTE DSC$B_DTYPE
	  BYTE DSC$B_CLASS
	  INTEGER*4 DSC$A_POINTER
	  END STRUCTURE
	INTEGER*2 ICNT
	RECORD /DSC/ INPUT
	INTEGER*2 OUTPUT(*)
 
	BYTE INPUT_CHARS(*)
	POINTER (INPUT_P, INPUT_CHARS)
 
	BYTE ASCII_RAD50(0:255) /32*-1,O'00',3*-1,O'33',9*-1,O'34',-1,
	1  O'36',O'37',O'40',O'41',O'42',O'43',O'44',O'45',O'46',O'47',
	2  7*-1,O'1',O'2',O'3',O'4',O'5',O'6',O'7',O'10',O'11',O'12',
	3  O'13',O'14',O'15',O'16',O'17',O'20',O'21',O'22',O'23',O'24',
	4  O'25',O'26',O'27',O'30',O'31',O'32',37*-1,128*-1/
 
	INTEGER*2 OUTPUT_COUNT,TRANS
	INTEGER*4 I
 
	! Determine if INPUT was passed by reference or by descriptor.
	! We can't tell for sure, but the VAX code used the following
	! checks.
	!
	INPUT_P = %LOC(INPUT)	! Assume reference
	IF ((INPUT.DSC$W_LENGTH .LE. 255) .AND.
	1   (INPUT.DSC$B_DTYPE .EQ. DSC$K_DTYPE_T) .AND.
	2   (INPUT.DSC$B_CLASS .EQ. DSC$K_CLASS_S))
	3  INPUT_P = INPUT.DSC$A_POINTER    ! Looks as if by descriptor
 
	IRAD50 = 0	! Initial return value
	OUTPUT_COUNT = 0
 
	! Loop through INPUT three characters at a time, building
	! the Radix-50 representation.
	!
	DO WHILE (IRAD50 .LT. ICNT)
	  OUTPUT_COUNT = OUTPUT_COUNT + 1
	  OUTPUT(OUTPUT_COUNT) = 0
	  DO I = 1,3
	    IF (IRAD50 .GE. ICNT) THEN
	      ! Pad last word with blanks
	      OUTPUT(OUTPUT_COUNT) = OUTPUT(OUTPUT_COUNT) * O'50'
	    ELSE
	      TRANS = ASCII_RAD50(INPUT_CHARS(I))
	      IF (TRANS .LT. 0) RETURN     ! Exit due to bad character
	      OUTPUT(OUTPUT_COUNT) = (OUTPUT(OUTPUT_COUNT) * O'50') + TRANS
	      IRAD50 = IRAD50 + 1  ! Indicate one more character translated
	      END IF
	    END DO
	  INPUT_P = INPUT_P + 3  ! Move to next three characters
	  END DO
	RETURN
	END

	REAL*4 FUNCTION RAD50(NAME)
	
C+
C 
C ABSTRACT:
C
C     Fortran version of the RAD50 function.
C
C FUNCTIONAL DESCRIPTION:
C 
C     RAD50 converts six ASCII characters to Radix-50
C 
C FORMAL PARAMETERS:
C  
C     NAME:
C	  A numeric variable or array element corresponding to a
C	  six-character Hollerith string, passed by reference or by
C	  descriptor
C  
C 
C FUNCTION VALUE:
C 
C     The Radix-50 translation of NAME.  Conversion stops when a
C     non-Radix-50 character is seen
C 
C DESIGN:
C  
C     See section B.3 of the DEC Fortran Language Reference Manual
C     and Appendix F of the DEC Fortran User Manual for OpenVMS VAX
C  
C-
	IMPLICIT NONE
	INTEGER*4 NAME
 
	! Call IRAD50 to do the conversion
	! 
	CALL IRAD50 (6,NAME,RAD50)
	RETURN
	END

	OPTIONS /CHECK=NOOVERFLOW
	SUBROUTINE R50ASC(ICNT,INPUT,OUTPUT)
	
C+
C 
C ABSTRACT:
C  
C     Fortran version of the R50ASC function.
C  
C FUNCTIONAL DESCRIPTION:
C 
C     R50ASC converts Radix-50 characters to ASCII characters.
C
C FORMAL PARAMETERS:
C  
C     ICNT:
C	  Specifies the number of characters of OUTPUT
C	  to be produced.  INTEGER*2
C      
C     INPUT:
C	  The Radix-50 variable or array element to be converted, passed
C	  by reference.
C      
C     OUTPUT:
C	  A numeric variable or array element where the
C	  ASCII results are stored.
C      
C 
C DESIGN:
C  
C     See section B.3 of the DEC Fortran Language Reference Manual
C     and Appendix F of the DEC Fortran User Manual for OpenVMS VAX
C  
C     If an individual Radix-50 character is invalid (O'35') or if the
C     word to be translated is greater than O'174777', question mark
C     characters are used for the result
C-
	IMPLICIT NONE
	INTEGER*2 ICNT,INPUT(*)
	BYTE OUTPUT(*)
	CHARACTER*1 TCHARS(3)
 
	CHARACTER*1 RAD50_ASCII(0:39) /' ','A','B','C','D','E','F',
	1  'G','H','I','J','K','L','M','N','O','P','Q','R','S','T',
	2  'U','V','W','X','Y','Z','$','.','?','0','1','2',
	3  '3','4','5','6','7','8','9'/
 
	INTEGER*4 TMP,INPUT_POS,OUTPUT_POS,I
 
	INPUT_POS = 0
	OUTPUT_POS = 0
	
	! Loop through input array, converting up to three characters
	! from each word.
	DO WHILE (OUTPUT_POS .LT. ICNT)
	  INPUT_POS = INPUT_POS + 1
	  TMP = ZEXT(INPUT(INPUT_POS))
	  IF (TMP .GT. O'174777') TMP = O'134745'   ! '???'
	  DO I=3,1,-1
	    TCHARS(I) = RAD50_ASCII(MOD(TMP,O'50'))
	    TMP = TMP / O'50'
	    END DO
	  DO I=1,3
	    IF (OUTPUT_POS .GE. ICNT) RETURN
	    OUTPUT_POS = OUTPUT_POS + 1
	    OUTPUT(OUTPUT_POS) = ICHAR(TCHARS(I))
	    END DO
	  END DO
	RETURN
	END
----- cut here -----
 
-- 
 
Steve Lionel                           [email-masked]
SDT Languages Group
Digital Equipment Corporation
110 Spit Brook Road
Nashua, NH 03062                       "Free advice is worth every cent"