C [CD.FOR] !Make Sub-Device (.DSK) files easy to PROGRAM CD ! define and redefine again and again. IMPLICIT INTEGER(A-Z) !Author:Daniel P. Graham LOGICAL*1 LINE(82),DEF(20) ! Digital Software Systems, Inc. LOGICAL*1 LINE2(20),EXT(4) ! 20 Bendix Place LOGICAL*1 PROMPT(30) ! Lindenhurst, NY 11757 C Program to define new logical devices (called LDn:) for accessing Sub-Device C files. A maximum of 8 logical devices may be defined at the same time. C Each Sub-Device file specified is assigned two logical names; "LDn:", C where "n" is a single octal digit representing the placement of the file C specification within the command line, and "xxx:" where "xxx" represents C the first three characters of the filename specified. In addition to C these, the logical name "DK:" will be assigned to the first Sub-Device C file or Device-Only specification appearing on the "CD" command line. C C The default superior device is "SY:", the default filename is "A", and the C default extension (or file type) is ".DSK". These can be changed by C editing the "SY:A.DSK" string in statement #1 and the ".DSK" string C following it. C C The command line is read with a GTLIN so input may come from either the C terminal or a command file. The following environment is required: C 1) Device SY: has at least 1 free block on it and is Write-Enabled. C 2) The file SY:CDCMD.COM is not protected or is Non-existent. C C Copyright (C) 1985, 1986 by DSSI. The information in this file is C free to all and may not be sold. C C Written on: 7-Mar-85 Latest Update: 25-Apr-86 C C by: Daniel P. Graham Loading Instructions: C Digital Software Systems Inc. .Compile CD.FOR C 20 Bendix Place .Link CD C Lindenhurst, NY 11757 or .Link/Debug:SDT CD C C Sample execution: C .CD SY:SDT,DL2:LIB.DSK,KERMIT,DL1:UTIL.DSK C C or .R CD C Connect to Sub-Device: SY:SDT,DL2:LIB.DSK,KERMIT,DL1:UTIL.DSK C C This will set your default device (DK:) to LD0: and define the logical C names SDT:, LIB:, KER:, and UTI: to point to their respective subdevice C files. C C Note that the default superior device will be the most recent device C specified. Also note that the assignment of LD0: as DK: will occur only C if the first file specified actually exists at the time CD is run. C C The command: .CD C Connect to Sub-Device: C . C will simply define DK: as SY: effectively undoing prior CDs. C C Use the .Copy/Device command to create .DSK files, or the following: C .Create NEW.DSK/Allocate:nnnn C .CD NEW C .Initialize DK:/Noquery C . C Setup our defaults. 1 CALL MOVEB('SY:A.DSK ',DEF,20) !Default Device & file name CALL MOVEB('.DSK',EXT,4) !Define the default Extension CALL MOVEB('Connect to Sub-Device: ',PROMPT,23) !Prompt for .R CD PROMPT(24) = "200 !Terminate the prompt string C Get the name of the logical device (and extra dir). Default Ext = .DSK 10 CALL GTLIN(LINE,PROMPT) !Get command line arguments 13 IF(LINE(1).EQ.' '.OR.LINE(1).EQ.0) CALL MOVEB('SY:',LINE,4) !Def=SY: C Open a new .COM file for indirect commands 15 OPEN(UNIT=1,NAME='SY:CDCMD.COM',ACCESS='SEQUENTIAL',TYPE='NEW') WRITE(1,72) !Put "Set TT Quiet" in CDCMD C Parse the input line. 20 LEN = LENGTH(LINE,0) + 1 !Get the line length LINE(LEN) = 0 !Terminate the line with a ^@ I = 0 !Initialize a line pointer SPEC = 0 !Initialize a filespec counter 21 START = I + 1 ! and starting position 22 I = I + 1 !Increment our line pointer IF(I.GT.LEN) GO TO 30 !Are we done yet? Yes-Goto 30 IF(LINE(I).NE.','.AND.LINE(I).NE.0) GO TO 22 !Skip all but "," & "^@" DO 23 K=1, 20 !Initialize LINE2(K) = 0 ! the secondary 23 CONTINUE ! buffer. CALL MOVEB(LINE(START),LINE2(1),I-START) !Move spec to new buffer CALL MAKEXT(LINE2,EXT,DEF,DOFLAG) !Supply default DEV: & .EXT L = LENGTH(LINE2,0) !Get full spec length COLON = INDEX(LINE2,':') !Find the index of the ":" PERIOD= INDEX(LINE2,'.') !Find the index of the "." IF(DOFLAG.EQ.0) GO TO 25 !Was Device-Only specified ? WRITE(1,76) (LINE2(J),J=1,L-1) !Yes - The only command to do WRITE(1,77) ! is: "Assign DEV DK". GO TO 28 !Update the SPEC count 25 WRITE(1,73) SPEC,(LINE2(J),J=1,L) !Write the MOUNT command L = PERIOD - COLON - 1 !Get file name length 26 IF(L.GT.3) L = 3 !Max pseudo DEV: name length=3 WRITE(1,74) SPEC,(LINE2(J),J=COLON+1,COLON+L) !"Assign LDn: dev:" IF(SPEC.NE.0) GO TO 28 !Is this assignment for LD0: ? OPEN(UNIT=2,NAME=LINE2,TYPE='OLD',ERR=28) !Does the file exist ? WRITE(1,75) !Yes - Make the DK: assigmnent CLOSE(UNIT=2) !Close the .DSK file 28 SPEC = SPEC + 1 !Count the filespecs processed GO TO 21 !Check for more filespecs C Tell RT-11 that the command "@SY:CDCMD.COM" is to be executed upon Exit. 30 WRITE(1,78) !Set TT No Quiet again CLOSE(UNIT=1) !Close the CDCMD.COM file CALL SETCMD('$@SY:CDCMD.COM') !Tell sys to: "$@SY:CDCMD.COM" 69 CALL EXIT !Exit quietly (no message). C Formats... 71 FORMAT(255A1) 72 FORMAT('+Set TT Quiet') 73 FORMAT(' Mount LD',I1,': ',20A1) 74 FORMAT(' Assign LD',I1,' ',3A1) 75 FORMAT(' Assign LD0 DK') 76 FORMAT(' Assign ',$,4A1) 77 FORMAT('+ DK') 78 FORMAT(' Show Subset'/' Delete SY:CDCMD.COM'/' Set TT No Quiet') END !End of Fortran-IV Program CD SUBROUTINE MAKEXT(FILNAM,EXT,DEF,DOFLAG) IMPLICIT INTEGER (A-Z) LOGICAL * 1 FILNAM(20),EXT(4),DEF(20) C Routine to edit the file specification in FILNAM by supplying a default C device, file name, or extension (if any part is missing). The C extension is always replaced by the contents of EXT. The file C specification returned is of the form "DEV:NAME.EXT" unless a C DEV: was the only string specified. C FILNAM - The ASCII file specification to be edited (Given and Updated). C EXT - The ASCII extension to always use (Given). C DEF - The ASCII default file specification DEV:Name.Ext (Given). C DOFLAG - Integer*2 Device-Only flag (Non-Zero=Device-Only was specified) 10 EOL = LENGTH(FILNAM,0) + 1 !Get the spec length DOFLAG = 0 !Init Device-Only flag FILNAM(EOL) = 0 !Terminate the specification DLEN = INDEX(DEF,':') !Get default DEV: length C Check the Device part 15 IF(INDEX(FILNAM,':').NE.0) GO TO 30 !Was a device name supplied? DO 20 I = EOL, 1, -1 !No - Supply one. Move the FILNAM(I+DLEN) = FILNAM(I) ! specification to the right 20 CONTINUE ! DLEN characters to make room 29 CALL MOVEB(DEF,FILNAM,DLEN) ! for the default DEV:. EOL = EOL + DLEN !Update the new EOL C Install the Extension part 30 I = INDEX(FILNAM,'.') !Search for a "." IF(I.NE.0) GO TO 40 !Found - Quit now I = INDEX(FILNAM,'/') !Not found? Look for a "/" IF(I.EQ.0) I = INDEX(FILNAM,' ') !No find? Find last Blank IF(I.EQ.0) I = EOL !Not found? use spec length CALL MOVEB(EXT,FILNAM(I),4) !Put Extension at end of name FILNAM(I+4) = 0 !Terminate the new spec. C Check the Name part 40 EOL = INDEX(FILNAM,':.') !Was device only specified ? IF(EOL.EQ.0) GO TO 60 !No - We're done C This code installs the default filename (when none is given) from array DEV. C I = INDEX(DEF,'.')-INDEX(DEF,':')-1 !Get the length of old Name C CALL MOVEB(DEF(INDEX(DEF,':')+1),FILNAM(INDEX(FILNAM,':')+1),I) C EOL = INDEX(FILNAM,':') + I + 1 !Define the new EOL C GO TO 30 !Install the extension again C This code flags the DEVICE-ONLY condition & returns only the device name. FILNAM(EOL+1) = 0 !Terminate the device name DOFLAG = -1 !Set the Device-Only flag GO TO 69 !Return to caller 60 CALL MOVEB(FILNAM,DEF,20) !Save this as last file used 69 RETURN !Return to caller END !End of Fortran routine MAKEXT FUNCTION LENGTH (STRING,MAX) IMPLICIT INTEGER(A-Z) LOGICAL * 1 STRING(MAX) C Routine to return the length of a string. If MAX is equal to Zero C then search forward, incrementing LENGTH, until a Blank, Tab C Semi-Colon, Exclaimation Point, or Null is found. If Max is C Greater than Zero then reverse search STRING starting at C STRING(MAX) for the first Non-Blank or Non-Null character. C Its position (relative to STRING) is the value returned by C LENGTH. LENGTH will always return a Zero or positive value. C STRING - The Quoted Literal or String Array to test (Given). C MAX - The maximum number of characters in STRING or Zero (Given). 10 IF(MAX.EQ.0) GO TO 40 !Search forward? C Reverse search string 20 DO 29 I = MAX, 1, -1 !No - Reverse Search LENGTH = I !Save the current position IF(STRING(I).NE.32.AND.STRING(I).NE.0) GO TO 50 !Test for E-o-S 29 CONTINUE !Continue till done 30 LENGTH = 0 !String is only Blank or Null GO TO 50 !Return to caller C Forward search string 40 DO 49 I = 1, 32767 !Max LENGTH is pretty long LENGTH = I - 1 !Save current position IF(STRING(I).EQ.32.OR.STRING(I).EQ.9.OR.STRING(I).EQ.0.OR. + STRING(I).EQ.33.OR.STRING(I).EQ.59) GO TO 50 49 CONTINUE !Continue till done C Return to caller 50 RETURN !Return to caller END !End or Function LENGTH SUBROUTINE MOVEB(SOURCE,DESTIN,LENGTH) IMPLICIT INTEGER(A-Z) LOGICAL * 1 SOURCE(LENGTH),DESTIN(LENGTH) C Routine to move the contents of one byte array to another. C SOURCE - The source array name (Given) C DESTIN - The destination array name (Updated) C LENGTH - The number of bytes to move from SOURCE to DESTIN (Given). 10 DO 20 I = 1, LENGTH !For each byte in the source DESTIN(I) = SOURCE(I) ! assign it to the destination 20 CONTINUE !Continue till finished 30 RETURN !Return to caller END !End of Fortran routine MOVEB