C PROGRAM LISTFL.FT C ================== C C C SUBROUTINE LISTFL(FILENAME,PAGE,ALPT,LPTSW) C C C C P. LEMKIN C NATIONAL INSTITUTES OF HEALTH C BETHESDA, MD 20014 C C C MAY 10, 1972 C C INTRODUCTION C ---------- C LISTFL LISTS THE ".DA" FILE SPECIFIED IN THE CALL ON THE LPT: C WHERE: FILENAME IS A 6 CHARACTER FILENAME WITH TRAILING SPACES C OR TRAILING ZEROS. THERE ARE SEVERAL EDIT CODES WHICH ARE C DESCRIBED IN THE FOLLOWING TABLE. THE EDIT CODE C MUST BE STARTED IN COLUMN 1 THROUGH 13 OR IT WILL NOT BE C PICKED UP. C C C EDIT CODE FUNCTION C --------- -------- C 1. "*""*"PAGE FORCE THE PRINTING OF A NEW PAGE C 2. "*""*"LSOF DISABLE THE LISTING FROM THIS LINE ON. C 3. "*""*"LSON REENABLE THE LISTING FROM THIS LINE ON. C 4. "*""*"DEAF DO NOT LISTEN FOR THE OTHER EDIT CODES... C 5. "*""*"HEAR LISTEN AGAIN FOR THE OTHER EDIT CODES.. C C C C C ARGUMENTS C ------------ C 1. FILENAME - THE FILE NAME OF THE ".DA" FILE TO BE LISTED. C 2. PAGE - A SWITCH WITH VALUE 'YES' OR 'NO' TO C USE SEQUENCE #'S. C 3. ALPT - OUTPUT DEVICE IF LPTSW IS NOT ZERO. C 4. LPTSW - IF 0, THE UTIL2 LPT:, ELSE DEVICE IN ALPT (GEN I/O) C C C C C C C SUBROUTINES USED C ================ C 1. UTIL2.SB - TO FIND THE EOF USES EOF SUBROUTINE. C 2. DATE.FT - ACCESS THE DATE WORD. C C**PAGE COMMON STACK DIMENSION IA(140),KP(6,10),PK(2,10),MATCH(10),STACK(150,2) EQUIVALENCE (KP(1,1),PK(1,1)) C C C C C 1. SET UP THE ***CONSTANTS*** LSTON=0 LLPT=3 IDEAF=-1 YES='YES ' KPAGE=1 FLINE=0.0 LPAGE=0 ISPACE=32*64+32 FN=FILENAME NBMATCH=5 PK(1,1)='* * P ' PK(2,1)='A G E ' PK(1,2)='* * L ' PK(2,2)='S O F ' PK(1,3)='* * L ' PK(2,3)='S O N ' PK(1,4)='* * D ' PK(2,4)='E A F ' PK(1,5)='* * H ' PK(2,5)='E A R ' C ***END OF CONSTANTS*** C C C C C 1.1 OPEN DEVICE 4 IS LPTSW IS NOT 0. IF(LPTSW)12,11,12 12 CALL OOPEN(ALPT,'JUNK') LLPT=4 C C C C C C C 2. GET THE DATA AND PRINT THE HEADER... 11 CALL DATE(IMO,IDAY,IYR) WRITE(LLPT,987)FN,IMO,IDAY,IYR,KPAGE 987 FORMAT('LISTING FILE: ',A6,'.DA DATE:',I2,'-',I2,'-197',I1, 1' PAGE ',I4,////) 999 FORMAT(////) C C C C 3. SET EOF FLAG TO 0000, I.E. NO ^Z CALL EOF(IEOF) C C C C C 4. OPEN THE INPUT FILE FROM THE DSK: CALL IOPEN('DSK',FILENAME) C C C C 5. LOOP HERE ON READING A LINE. 10 CONTINUE READ(4,100) (IA(I),I=1,140) C C C C 6. INCREMENT THE PAGE AND LINE COUNTERS. IF(LSTON)7,6,6 6 LPAGE=LPAGE+1 FLINE=FLINE+1.0 C C C C 7. TEST IF END OF FILE C TEST IEOF FLAG WHICH IS SET TO -1 ON SEEING A ^Z 7 CALL EOF(IEOF) IF(IEOF)200,45,200 C C 8. NOT YET, FIND END OF LINE "N". 45 DO 55 K=1,140 L=141-K C COUNT BACKWARDS SEE IF ZERO ISSS=IA(L)-ISPACE IF(ISSS)56,55,56 55 CONTINUE 56 N=L C C C C C C C 9. TEST IF THE EDIT CODES ARE IN THIS LINE, IF SO SET THE C MATCH FLAG FOR THAT CODE TO 0, ELSE -1... C IF YOU ARE DEAF, THEN DONT LISTEN FOR ANYTHING EXCEPT HEAR. GOTO 1710 C C C C 9.1 IF THE LISTING IS SHUT OFF, DONT TRY TO MATCH PAGE OR LSOF IF(LSTON)1703,1704,1704 1703 IFROM=3 GOTO 1710 C C C C C 9.2 DO IT FOR ALL EDIT CODES. 1704 IFROM=1 C C C C C 9.3 DO IT FOR SELECTED EDIT CODES. 1710 DO 762 M=IFROM,NBMATCH MATCH(M)=-1 C C 9.4 DO IT FOR EACH STARTING LETTER IN THE LINE. C UP TO THE 13'TH LETTER. IF(L-13)765,764,764 764 LLIM=13 GOTO 768 765 LIM=L 768 DO 762 I=1,LIM C C C C C 9.5 CONVOLVE THE LINE DO 761 J=1,6 K=J-1 IF(KP(J,M)-IA(I+K))762,761,762 761 CONTINUE C C C C 9.6 IT IS AN EXACT MATCH MATCH(M)=0 762 CONTINUE C C C C C C 10. TEST IF WE SHOULD HEAR, THEN RESET THE DEAF FLAG. IF(MATCH(5))781,780,780 780 IDEAF=-1 C C 11. TEST IF DEAF... 781 IF(IDEAF)798,782,782 C C C 12. DEAF RESET THE OTHER CODES TO -1 782 DO 783 M=1,NBMATCH 783 MATCH(M)=-1 C C C C 13. TEST IF TURN ON OR OFF THE LSTON FLAG. 798 IF(MATCH(2))901,902,901 902 LSTON=-1 C FIRST PRINT THE SWITCH BEFORE LEAVING.. GOTO 1801 901 IF(MATCH(3))799,903,799 903 LSTON=0 GOTO 10 C C C 14.********* GO DO THE LISTING IF YOU CAN********* 799 CONTINUE C C C C C C 15. SAW A "*""*"DEAF?, SET THE DEAF FLAG ON... 800 IF(MATCH(4))801,787,787 787 IDEAF=0 C C C 16. TEST FOR "*""*"LSON', THEN SAW THE "*""*"PAGE EDIT CODE? 801 IF(LSTON)10,1801,1801 1801 IF(MATCH(1))802,803,802 C YES, FINISH OUT THIS PAGE WITH BLANKS. 803 NMORE=57-LPAGE IF(NMORE)756,756,754 754 DO 755 I=1,NMORE 755 WRITE(LLPT,757) 757 FORMAT() C GO DO THE NEXT HEADER 756 LPAGE=56 GOTO 763 C C C 17. TEST IF PRINT THE SEQUENCE #'S 802 IF(PAGE-YES)78,77,78 77 WRITE(LLPT,104)FLINE,(IA(I),I=1,N) 104 FORMAT(' ',F8.0,3X,140A1) GOTO 79 C C C C 18. DO NOT PRINT THE SEQUENCE NUMBERS. 78 WRITE(LLPT,100) (IA(I),I=1,N) 79 CONTINUE C C C C C 19. TEST IF PAGINATE 763 IF(LPAGE-56)88,806,88 806 WRITE(LLPT,999) C C C C C 20.TEST IF PRINT THE PAGE # AS WELL? 805 KPAGE=KPAGE+1 IF(PAGE-YES)809,807,809 807 WRITE(LLPT,987)FN,IMO,IDAY,IYR,KPAGE GOTO 103 C C C C C 21. NO DO NOT PRINT THE SUBTITLE. 809 WRITE(LLPT,999) 103 LPAGE=0 88 GOTO 10 100 FORMAT(140A1) 200 CONTINUE C C C C C 22. FINISH OFF THE PAGE NMORE=62-LPAGE IF(NMORE)556,556,554 554 DO 810 I=1,NMORE 811 WRITE(LLPT,557) 557 FORMAT() 810 CONTINUE C C C TEST IF A GENERAL I/O DEVICE, THEN CLOSE IT... 556 IF(LPTSW)559,558,559 559 CALL OCLOSE 558 RETURN END