FTN4,L PROGRAM DIRCT(3,90) DIMENSION IFIL(3),IT(32),NDIRC1(3),NDIRC2(3),NDIRC3(3) COMMON JDRTRK,ISCTR,ISCT,ITRK,LUOP,LUCR,LU,LUIN,LBUF(128), 1NFILS,IFRST,NMFIL(1600),LBLF(1200),JSECTR,IPNT, 2LCODE,ICEL,MXFILS C C C C************************************************************** C * C THIS PROGRAM IS DESIGNED TO MAINTAIN A DISK FILE CONTAINING * C THE SYMBOLIC NAMES OF SELECTED USER FILES TOGETHER WITH AS * C MANY AS 64 CHARACTERS OF DESCRIPTIVE INFORMATION ON EACH FI-* C LE. IT MUST HAVE ACCESS TO A BINARY DATA FILE * C WHOSE LENGTH IN BLOCKS IS CALCULATED FROM THE FOLLOWING * C EXPRESSION: * C #SECTORS = (MXFILS*4 + 2)/64 + MXFILS/2 + 2 * C #BLOCKS = (#SECTORS(64 WORDS) + 1)/2 * C WHERE, MXFILS = THE MAXIMUM NUMBER OF ENTRIES ALLOWED. * C * C A LISTING OF THE EXECUTION DIRECTIVES IS GIVEN UPON CALLING * C THIS PROGRAM AND EACH TIME AN IMPROPER DIRECTIVE IS ISSUED. * C THE DIRECTORY FILE MAY BE CLEARED BY ISSUING THE INITIALIZE * C DIRECTIVE (%%). THIS DIRECTIVE IS NOT LISTED WITH THE * C OTHERS SINCE IT'S EFFECT IS NOT REVERSABLE AND SHOULD ONLY * C BE USED AFTER CAREFULL CONSIDERATION. THE PROGRAM IS SELF * C INITIALIZING THE FIRST TIME IT IS EXECUTED AFTER BEING * C INSTALLED ON A USER CARTRIDGE. IT MUST BE INSTALLED ON * C EACH CARTRIDGE FOR WHICH IT WILL MAINTAIN A DIRECTORY. * C A BACK UP DIRECTORY FILE MAY BE KEPT ON PAPER OR MAG TAPE * C BY USING THE DI DIRECTIVE AFTER ASSIGNING THE DESIRED LU. * C * C MAURICE C. COTE AUGUST 15, 1973 * C REVISION C. NOVEMBER 21, 1974 * C H.P. EASTERN SALES REGION LEXINGTON MASS. * C************************************************************** C C C DATA NDIRC1/2HDI,2HRC,2H1 / DATA NDIRC2/2HDI,2HRC,2H2 / DATA NDIRC3/2HDI,2HRC,2H3 / C C GET THE LOGICAL UNITS AS PASSED FROM THE SCHEDULER. C PARAMETER 1 = OPERATORS CONSOLE LU DEFAULT = 1 C PARAMETER 2 = CARTRIDGE LU DEFAULT = 2 C PARAMETER 3 = LIST DEVICE LU DEFAULT = 6 C PARAMETER 4 = INPUT DEVICE LU DEFAULT = OPERATORS CONSOLE C CALL RMPAR(LUOP) C IF(LU .EQ.0) LU = 6 IF(LUCR.EQ.0) LUCR = 2 IF(LUOP.EQ.0) LUOP = 1 IF(LUIN.EQ.0) LUIN = LUOP C C C MXFILS = THE MAXIMUM NUMBER OF DIRECTORY ENTRIES. C IN ORDER TO CHANGE THIS MAXIMUM, IT IS ONLY NECESSARY C TO CHANGE THE VALUE OF MXFILS AND THE DIMENSION OF THE C VARIABLES NMFIL & LBLF IN THE COMMON DECLARATION. C THESE SHOULD BE DIMENSIONED TO 4*MXFILS & 3*MXFILS C RESPECTIVELY. C THE ADDRESSING ALGORITHM WILL ALLOW A MAXIMUM OF 905 ENTRIES C MXFILS = 400 C C GO INITIALIZE THE PROGRAMS COMMON C 100 CALL LINK(NDIRC1) C C SAVE THE TAT ENTRY IF LU = 2 - ELSE SET ICEL = 0 C ITATA = IGET(1656B) + JDRTRK ICEL = 0 IF(LUCR.EQ.102B) ICEL = IGET(ITATA) C C C GET THE FILE NAMES IN THE DIRECTORY AND THE NUMBER OF ENTRIES C C WILL THIS READ CROSS A TRACK BOUNDARY ? C 200 L1 = MXFILS*4 + 2 L2 = -1 LSMAX = 95 - L1/64 IF(JSECTR.GT.LSMAX) GO TO 202 CALL EXEC(1,LUCR,NFILS,L1,JDRTRK,JSECTR) GO TO 205 C C SPLIT THE READ BETWEEN THE TWO TRACKS AS REQUIRED. C 202 L1 = (96 - JSECTR)*64 L2 = MXFILS*4 + 2 - L1 JP = L1 - 1 CALL EXEC(1,LUCR,NFILS,L1,JDRTRK,JSECTR) CALL EXEC(1,LUCR,NMFIL(JP),L2,JDRTRK + 1,0) C C GO INITIALIZE THE DIRECTORY IF THIS IS THE FIRST EXECUTION C UPON INSTALLATION OF THE DIRECTORY. C 205 IF(IFRST.EQ.125252B)210,6005 C C GET THE FUNCTION CODE C 210 WRITE(LUOP,510) C C SAVE THE NAME FILE ON DISK C IF(ICEL.NE.0) CALL IPUT(ITATA,77777B) CALL EXEC(2,LUCR,NFILS,L1,JDRTRK,JSECTR) C C TWO CALLS TO EXEC(2 REQUIRED IF CROSSING TRACK BOUNDARY. C IF(L2)220,215 C 215 IF(ICEL.NE.0) CALL IPUT(ITATA+1,77777B) CALL EXEC(2,LUCR,NMFIL(JP),L2,JDRTRK + 1,0) IF(ICEL.NE.0) CALL IPUT(ITATA+1,ICEL) 220 IF(ICEL.NE.0) CALL IPUT(ITATA,ICEL) READ(LUOP,515)LCODE C IF(LCODE.EQ.2HDI) CALL LINK(NDIRC2) IF(LCODE.EQ.2HLI) CALL LINK(NDIRC2) IF(LCODE.EQ.2HPU) CALL LINK(NDIRC2) IF(LCODE.EQ.2HUP) CALL LINK(NDIRC2) IF(LCODE.EQ.2HEN) CALL LINK(NDIRC3) IF(LCODE.EQ.2H%%) CALL LINK(NDIRC2) IF(LCODE.EQ.2HLU) CALL LINK(NDIRC2) IF(LCODE.EQ.2HOF) GO TO 9000 IF(LCODE.EQ.2H?? ) GO TO 6010 IF(LCODE.EQ.2HCR) GO TO 300 IF(LCODE.EQ.-1 ) GO TO 210 GO TO 6010 C C GET A NEW CARTRIDGE LU NUMBER C 300 WRITE(LUOP,520) READ(LUOP,*)LUCR GO TO 100 C C THIS SECTION FOR THE INITIAL INITIALIZATION. C 6005 NFILS = -1 CALL LINK(NDIRC2) C C OUTPUT A LIST OF PROGRAM DIRECTIVES C 6010 WRITE(LUOP,505) GO TO 210 C C C THIS SECTION WILL RETURN AFTER TOOTING THE CONSOLE HORN C C 9000 WRITE(LUOP,580) C C C C FORMAT SECTION C C C 505 FORMAT(/26X,"USER FILE DIRECTORY"//"COMMANDS ARE :"/, 1"(LI)ST - LIST A GIVEN ENTRY"/, 2"(UP)DATE - LIST ALL FILE NAMES NOT IN THE DIRECTORY"/ 3"(DI)RECTORY - LIST ALL ENTRIES IN THE DIRECTORY"/ 4"(PU)RGE - REMOVE ALL UNUSED ENTRIES FROM THE DIRECTORY"/ 6"(LU) - RESET THE LIST & INPUT LU"/ X"(??) - LIST ALL EXECUTION OPTIONS"/ X"(CR) - CHANGE CARTRIDGE LOGICAL UNIT"/ 5"(EN)TER - ENTER A FILE NAME IN THE DIRECTORY"/ 6"(OF)F - RETURN TO THE SYSTEM EXEC"/) 510 FORMAT(/"/DIRCT:"/"NEXT _") 515 FORMAT(A2) 520 FORMAT(/"CARTRIDGE LU _") 580 FORMAT("") C C C END SUBROUTINE GETB COMMON JDRTRK,ISCTR,ISCT,ITRK,LU(4),LBUF(128), 1NFILS,IFRST,NMFIL(1600),LBLF(1200),JSECTR EQUIVALENCE (LU(2),LUCR) C ITRK = JDRTRK + (ISCTR + JSECTR)/96 ISCT = MOD((ISCTR + JSECTR),96) CALL EXEC(1,LUCR,LBUF,128,ITRK,ISCT) END END$ ASMB,R,L NAM IGET,7 ENT IGET IGET NOP DLD IGET,I SWP LDA 0,I LDA 0,I JMP 1,I END ASMB,R,L NAM LINK,7 ENT LINK,RETRN EXT EXEC,.ENTR NAMAD BSS 1 LINK NOP JSB .ENTR GET SEGMENT NAME DEF NAMAD ADDRESS LDA NAMAD STA CALLP STORE IN SEQUENCE BELOW JSB EXEC PROGRAM SEGMENTLOADING DEF *+3 DEF RCODE SEQUENCE CALLP NOP JMP * * RETRN NOP JMP LINK,I RETURN TO MAIN PROGRAM * RCODE DEC 8 END FTN4,L PROGRAM DIRC1(5,99) DIMENSION IFIL(3),IT(32) COMMON JDRTRK,ISCTR,ISCT,ITRK,LUOP,LUCR,LU,LUIN,LBUF(128), 1NFILS,IFRST,NMFIL(1600),LBLF(1200),JSECTR,IPNT, 2LCODE,ICEL,MXFILS C C FIND THE NUMBER OF TRACKS ON THE SYSTEM AND THE FIRST C DIRECTORY TRACK - THEN READ IT. C JOFST = 17 IOFST = 14 IDRTRK = IGET(1756B) - 1 CALL EXEC(1,102B,LBUF,128,IDRTRK,0) C C IS THE DIRECTORY REQUEST FOR THE SYSTEM CARTRIDGE OR C FOR A PERIPHERAL PACK/DISK ? C IF(LUCR.EQ.2) GO TO 35 C C IS THE REQUESTED LOGICAL UNIT MOUNTED ? C DO 20 I=1,125,4 IF(LUCR.EQ.LBUF(I)) GO TO 30 C C QUIT IF THE WORD = 0 C IF(LBUF(I).EQ.0) GO TO 25 20 CONTINUE C C CANT' FIND THE SPECIFIED LU !! C 25 WRITE(LUOP,605) STOP C C GET THE FIRST DIRECTORY TRACK FOR THIS LOGICAL CARTRIDGE. C 30 IDRTRK = LBUF(I+1) IOFST = 0 C C NOW, LOAD THE NAMES FROM THE DIRECTORY INTO ARRAY AND C LOCATE THE DIRECTORY DATA FILE C 35 IPNT = 1 LUCR = LUCR + 100B JDRTRK = -1 40 CALL EXEC(1,LUCR,LBUF,128,IDRTRK,IOFST) C DO 55 J=JOFST,113,16 C C IF THE FIRST WORD OF THE NAME = -1 THEN THIS ENTRY HAS BEEN C DELETED. C IF(LBUF(J).EQ.-1) GO TO 55 C C IF THE FIRST WORD OF THE NAME = 0 THEN THIS IS THE END C OF THE DIRECTORY. C IF(LBUF(J).EQ.0) GO TO 100 C C QUIT IF TOO MANY FILES FOR THIS SIZE DIRECTORY C IF(IPNT.EQ.(MXFILS*3 + 1)) GO TO 300 C C NEITHER OF THE ABOVE CASES SO, SAVE THIS NAME. C DO 45 I=0,2 LBLF(IPNT) = LBUF(J+I) 45 IPNT = IPNT + 1 C C IS THIS FILE NAME ? C IF(LBUF(J).NE.2HDI) GO TO 55 IF(LBUF(J+1).NE.2HRC) GO TO 55 IF(LBUF(J+2).NE.2HT$) GO TO 55 C C YES THEN SAVE IT'S TRACK AND SECTOR. C JDRTRK = LBUF(J+4) JSECTR = LBUF(J+5) NSECTS = LBUF(J+6) 55 CONTINUE C C INCREMENT THE SECTOR NUMBER BY 14 - C WRAP AROUND IF SECTOR # >96 OR C DECREMENT TRACK # IF SECTOR # = 96. C JOFST = 1 IOFST = IOFST + 14 IF(IOFST.GE.96) IOFST = IOFST - 96 IF(IOFST.EQ.0) IDRTRK = IDRTRK -1 GO TO 40 C C SAVE THE FILE NAME BUFFER LENGTH IN WORDS. C 100 IPNT = IPNT - 1 C C HAS A DIRECTORY FILE BEEN FOUND ? C AND IS AT LEAST SECTORS (/2 BLOCKS) LONG ? C N = (MXFILS*4 + 2)/64 + MXFILS/2 + 2 IF(JDRTRK.EQ.-1) GO TO 110 IF(NSECTS.LT.N) 120,200 C C DIRECTORY FILE ERROR !! C 110 WRITE(LUOP,500) STOP C 120 N = (N + 1)/2 WRITE(LUOP,510)N STOP 200 LCODE = -1 CALL RETRN C C DETERMINE CAUSE OF FAILURE - IF DIRCTD FOUND, C CONTINUE THE PROGRAM ELSE QUIT. C 300 WRITE(LUOP,505)MXFILS C IF(JDRTRK)110,100 C C C C 500 FORMAT(/"FILE NOT FOUND"/) 505 FORMAT(/"MORE THAN ",I3," FILE NAMES IN FMGR DIRECTORY"/) 510 FORMAT(/" MUST BE",I4," BLOCKS"/) 605 FORMAT(/"CARTRIDGE NOT MOUNTED THIS LU"/) C C END END$ FTN4,L PROGRAM DIRC2(5,99) DIMENSION IFIL(3),IT(32) COMMON JDRTRK,ISCTR,ISCT,ITRK,LUOP,LUCR,LU,LUIN,LBUF(128), 1NFILS,IFRST,NMFIL(1600),LBLF(1200),JSECTR,IPNT, 2LCODE,ICEL,MXFILS C IF(NFILS.EQ.-1) GO TO 6000 IF(LCODE.EQ.2HLI) GO TO 2000 IF(LCODE.EQ.2HPU) GO TO 3000 IF(LCODE.EQ.2HUP) GO TO 4000 IF(LCODE.EQ.2H%%) GO TO 6000 IF(LCODE.EQ.2HLU) GO TO 7000 C C C C THIS IS THE DIRECTORY LIST SECTION C C C DONT ATTEMPT A DIRECTORY LISTING IF NONE AVAILABLE C 1000 LCODE = -1 IF(NFILS.EQ.0) CALL RETRN C DO 1100 I=1,NFILS*4,4 C C THIS ENTRY IS DELETED IF LESS THAN 0 C IF(NMFIL(I))1100,1010 C C GET THE RELATIVE SECTOR AND OFFSET FROM WORD 4 OF FILE NAME C 1010 ISCTR = IAND(NMFIL(I + 3),777B) CALL GETB IOFF = NMFIL(I + 3)/512*32 + 1 C C USE PROPER FORMAT IF LU = 6 (LINE PRINTER) C IF(LU.EQ.6) GO TO 1030 WRITE(LU,520)(NMFIL(J),J=I,I + 2),(LBUF(J),J=IOFF,IOFF + 31) GO TO 1100 1030 WRITE(LU,521)(NMFIL(J),J=I,I + 2),(LBUF(J),J=IOFF,IOFF + 31) 1100 CONTINUE C C WRITE A :: C WRITE(LU,590) LCODE = -1 CALL RETRN C C C THIS IS THE LIST OF INDIVIDUAL ENTRIES SECTION C 2000 LCODE = -1 WRITE(LUOP,525) READ(LUOP,530)IFIL C C QUIT IF FILE NAME = :: C IF(IFIL .EQ. 2H::) CALL RETRN C DO 2100 I=1,NFILS*4 + 1,4 DO 2050 J=1,3 C IF(IFIL(J).NE.NMFIL(J + I - 1)) GO TO 2100 C 2050 CONTINUE GO TO 2200 2100 CONTINUE C 2110 WRITE(LUOP,535) IFIL GO TO 2000 C 2200 ISCTR = IAND(NMFIL(I + 3),777B) CALL GETB IOFF = NMFIL(I + 3)/512*32 + 1 WRITE(LUOP,540)(LBUF(J),J=IOFF,IOFF + 31) GO TO 2000 C C C THIS SECTION WILL PURGE ALL ENTRIES OF DELETED FILES FROM THE C DIRECTORY. C C 3000 DO 3500 I=1,NFILS*4,4 DO 3100 J=1,IPNT,3 C IF(NMFIL(I).NE.LBLF(J)) GO TO 3100 C IF(NMFIL(I + 1).NE.LBLF(J + 1)) GO TO 3100 C IF(NMFIL(I + 2).EQ.LBLF(J + 2)) GO TO 3500 C 3100 CONTINUE C NMFIL(I) = -1 3500 CONTINUE LCODE = -1 CALL RETRN C C C THIS SECTION WILL LIST ALL USER FILE LABELS WHICH ARE NOT C ENTERED IN THE DIRECTORY. C C 4000 WRITE(LU,545) DO 4500 I=1,IPNT,3 DO 4100 J=1,NFILS*4,4 C IF(LBLF(I).NE.NMFIL(J)) GO TO 4100 C IF(LBLF(I + 1).NE.NMFIL(J + 1)) GO TO 4100 C IF(LBLF(I + 2).EQ.NMFIL(J + 2)) GO TO 4500 C 4100 CONTINUE C WRITE(LU,550)(LBLF(J),J=I,I + 2) C 4500 CONTINUE WRITE(LU,555) LCODE = -1 CALL RETRN C C C INITIALIZATION SECTION C 6000 NFILS = 0 IFRST = 125252B C C CLEAR ANY EXISTING FILE NAMES C DO 6010 J=1,MXFILS*4,4 6010 NMFIL(J) = 0 LCODE = -1 CALL RETRN C C THIS SECTION WILL ALLOW THE LIST & INPUT LU TO BE CHANGED C 7000 WRITE(LUOP,585) READ(LUOP,*)LU,LUIN LCODE = -1 CALL RETRN C C 520 FORMAT(3A2/32A2) 521 FORMAT(1H0,3A2/X,32A2) 525 FORMAT(/"FILE NAME _") 530 FORMAT(3A2) 535 FORMAT(/3A2," NOT IN THE DIRECTORY") 540 FORMAT(X,32A2/) 545 FORMAT(X/" NON-DIRECTORY FILE NAMES INCLUDE:") 550 FORMAT(X,3A2) 555 FORMAT(X/" * END OF LIST *") 585 FORMAT("LIST & INPUT DEVICE LOGICAL UNIT = _") 590 FORMAT(2H::) END END$ FTN4,L PROGRAM DIRC3(5,99) DIMENSION IFIL(3),IT(32) COMMON JDRTRK,ISCTR,ISCT,ITRK,LUOP,LUCR,LU,LUIN,LBUF(128), 1NFILS,IFRST,NMFIL(1600),LBLF(1200),JSECTR,IPNT, 2LCODE,ICEL,MXFILS C LCODE = -1 C C THIS SECTION WILL ENTER NEW ENTRIES IN THE DIRECTORY C 5000 WRITE(LUOP,525) READ(LUIN,530) IFIL C C QUIT IF FILE NAME = :: C IF(IFIL.EQ.2H::) GO TO 5400 C C GET THE FILE DESCRIPTION NOW C WRITE(LUOP,565) READ(LUIN,575)IT C C CHECK FOR DUPLICATE DIRECTORY ENTRY C DO 5100 JP=1,NFILS*4,4 C DO 5050 J=1,3 C IF(IFIL(J).NE.NMFIL(JP + J - 1)) GO TO 5100 C 5050 CONTINUE C WRITE(LUOP,570) IFIL READ(LUOP,515)LBL C IF(LBL.NE.2HYE)5000,5205 C 5100 CONTINUE C C LOOK FOR THE FIRST AVAILABLE NAME FILE SLOT C DO 5210 JP=1,NFILS*4,4 IF(NMFIL(JP))5205,5210 C C GET THE DISK RELATIVE SECTOR (BITS 0 - 8) AND THE SECTOR C WORD OFFSET (BITS 9 - 15) FROM THE FOURTH ENTRY C 5205 IOFF = NMFIL(JP + 3)/512 ISCTR = IAND(NMFIL(JP + 3),777B) GO TO 5300 C 5210 CONTINUE C C NO OLD SLOTS AVAILABLE - START A NEW ONE IF LESS THAN . C NFILS = NFILS + 1 C IF(NFILS.GT.MXFILS)5215,5220 C 5215 WRITE(LUOP,560) LCODE = -1 CALL RETRN C C CALCULATE THE STARTING WORD OFFSET FOR THIS BLOCK C (4 ENTRIES PER BLOCK). C 5220 IOFF = MOD(NFILS - 1,4) JP = (NFILS - 1)*4 + 1 C C CALCULATE THE LENGTH OF THE NAME AND ADDRESS SECTION + 1 C OF THE DATA FILE (SECTORS) C NADFIL = (MXFILS*4 + 2)/64 + 1 C C BE SURE TO START ON AN EVEN SECTOR NUMBER (BLOCK BOUNDARY) C IF(IAND(NADFIL,1).EQ.1) NADFIL = NADFIL + 1 C C SECTORS 0 TO NADFIL -1 ARE RESERVED FOR THE NAME & ADDRESS FILE. C C CALCULATE THE TOTAL SECTOR OFFSET FROM THE START OF THE C DIRECTORY FILE. C ISCTR = NADFIL + 2*((NFILS - 1)/4) C C READ THE PROPER SECTOR & TRACK FROM THE DISK FILE. C 5300 CALL GETB C C PUT THE DESCRIPTIVE INFO IN THIS BUFFER STARTING C AT THE PROPER WORD OFFSET. C IWD = IOFF*32 + 1 DO 5310 I=1,32 LBUF(IWD) = IT(I) 5310 IWD = IWD + 1 C C PUT IT BACK NOW C IF(ICEL.NE.0) CALL IPUT((IGET(1656B)+ ITRK),77777B) CALL EXEC(2,LUCR,LBUF,128,ITRK,ISCT) IF(ICEL.NE.0) CALL IPUT((IGET(1656B)+ ITRK),ICEL) C C NOW SAVE THE FILE NAME IN THE ARRAY. C DO 5320 I=1,3 NMFIL(JP) = IFIL(I) 5320 JP = JP + 1 NMFIL(JP) = IOFF*512 + ISCTR C C REPEAT INPUT SEQUENCE UNTIL FILE NAME = :: C GO TO 5000 C C NOW ALPHABETIZE THAT DIRECTORY FILE NAME IF NFILS > 1 C 5400 LCODE = -1 IF(NFILS .EQ. 1) CALL RETRN C DO 5700 N=1,NFILS - 1 NN = NFILS - N C C CLEAR THE SWAP FLAG C ISWP = 0 C DO 5600 I=0,NN - 1 C C COMPARE THESE TWO ADJACENT LABELS FOR ALPHABETIC ORDER C DO 5500 J=1,3 J1 = I*4 +J J2 = J1 + 4 C C ARE THE CHARACTERS THE SAME AS, HIGHER OR LOWER ON THE SCALE ? C IF(NMFIL(J1) - NMFIL(J2))5600,5500,5550 C C THEY ARE THE SAME - CHECK THE NEXT TWO C 5500 CONTINUE GO TO 5600 C C SWAP THESE TWO FILE NAMES AND DECSRIPTION FILE ADDRESS C AND SET THE SWAP FLAG C 5550 DO 5555 J=1,4 J1 = I*4 + J J2 = J1 + 4 LBL = NMFIL(J2) NMFIL(J2) = NMFIL(J1) 5555 NMFIL(J1) = LBL C ISWP = 1 C C NOW GO ON THROUGH THE LIST C 5600 CONTINUE C C NOW - DONE IF NO SWAP TOOK PLACE C IF(ISWP .EQ. 0)CALL RETRN C 5700 CONTINUE LCODE = -1 CALL RETRN C 515 FORMAT(A2) 525 FORMAT(/"FILE NAME _") 530 FORMAT(3A2) 560 FORMAT(/"TOO MANY FILES") 565 FORMAT(/"DESCRIPTION :") 570 FORMAT(/3A2,X,"DUPLICATE ENTRY"/" OK? _") 575 FORMAT(32A2) END END$