From SHOPPA@ALMACH.CALTECH.EDU Mon Feb 6 11:16:32 1995 Received: from almach.krl.caltech.edu by altair.krl.caltech.edu; (5.65/1.1.8.2/30Dec94-1225PM) id AA07226; Mon, 6 Feb 1995 11:16:32 -0800 Date: Mon, 6 Feb 1995 11:12:36 -0800 (PST) From: "Timothy D. Shoppa x4256" To: budd@cs.bu.edu Cc: SHOPPA@ALMACH.CALTECH.EDU Message-Id: <950206111236.20204b4f@ALMACH.CALTECH.EDU> Subject: Re: Dave Mills' Fuzzball Status: O Path: almach.caltech.edu!shoppa From: shoppa@almach.caltech.edu (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: <6FEB199511120560@almach.caltech.edu> References: <199502061547.KAA27653@csa.bu.edu> Organization: California Institute of Technology News-Software: VAX/VMS VNEWS 1.41 In article <199502061547.KAA27653@csa.bu.edu>, budd@cs.bu.edu (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. (shoppa@altair.krl.caltech.edu) 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 (shoppa@altair.krl.caltech.edu) 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('@xxx_xxx.com') 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: lionel@quark.enet.dec.com (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: <24osgg$c4k@jac.nuo.dec.com> Reply-To: lionel@quark.enet.dec.com (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 lionel@quark.enet.dec.com SDT Languages Group Digital Equipment Corporation 110 Spit Brook Road Nashua, NH 03062 "Free advice is worth every cent"