FTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18386 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C ACFDF - ROUTINE TO FIND A FREE ACCOUNT ENTRY C C CALLING SEQUENCE: CALL ACFDF(IDIRN,IRECN,IOFST,JERR,K) C WHERE C IDIRN = DIRECTORY ENTRY NUMBER OF FREE C ACCOUNT (RETURNED) C IRECN = RECORD NBR OF FREE ACCOUNT (RETURNED) C IOFST = 0 IF FREE ACCOUNT STARTS IN 1ST WORD, C 64 IF STARTS IN 65TH WORD (RETURNED) C JERR = ACERR RETURN WORD C K = 1 FOR NORMAL REQUEST C K = 2 FOR EXTENTION REQUEST C (STARTS ON SECTOR BOUNDARY) C C ACERRS: -201 = NO FREE ACCOUNTS OF THIS SIZE C FMP ACERR (READF) C C SUBROUTINE ACFDF(IDIRN,IRECN,IOFST,JERR,K) 1 ,92067-16361 REV.1940 781211 COMMON /ACOM6 /LOC(6) COMMON /ACOM1/NDCB(272),NBUF(128) C C C GET RECORD NUMBER OF START OF DIRECTORY C INITIALIZE DIRECTORY ENTRY NBR, INDEX TO DIRECTORY C IREC=LOC(5) IDIRN=1-K 100 I=1 C C READ THE NEXT RECORD OF DIRECTORY C CALL READF(NDCB,JERR,NBUF,128,LEN,IREC) IF(JERR.LT.0)RETURN C C CHECK FOR END OF DIRECTORY C 200 IDIRN=IDIRN+K 201 IWD1=NBUF(I) IF(IWD1.EQ.0) GO TO 500 C C CHECK IF DIRECTORY ENTRY POINTS TO A FREE ACCOUNT ENTRY (-1) C OR TO AN EXTENDED ACCOUNT ENTRY (-2) C IF(IWD1.GE.0.OR.IWD1.EQ.-2) GO TO 400 C C FOUND A FREE ACCOUNT C RETURN THE ACCOUNT RECORD NUMBER AND OFFSET C 300 IRECN=LOC(6)+(IDIRN-1)/ 2 IOFST=64*MOD(IDIRN-1,2) JERR=0 RETURN C C GET THE NEXT DIRECTORY ENTRY C IF SEARCHING FOR >64 WORDS, SEARCH ONLY THE ODD-NUMBERED C DIRECTORY ENTRIES C 400 I=I+(K*16) IF(I.LT.129) GO TO 200 IREC=IREC+1 GO TO 100 C C RETURN NO FREE ACCOUNTS OF THIS SIZE C 500 JERR=-201 RETURN END