File: USRTES.FT of Tape: Sources/Multi8/m8-mprog-f
(Source file text)
C C TEST USR3-ROUTINE IN FRUN 3-OCT-80 C C VERFASSUNG: W.V.D.MARK, ETHZ C C USR3 ERMOEGLICHT DEN FILE-ZUGRIFF UNTER FORTRAN IV C OHNE FRUN IRGENDWELCHE ANGABEN UEBER FILES ZU MACHEN. C DAMIT WIRD DASSELBE ERREICHT WIE IN FORTRAN II MIT C DEN ROUTINEN CALL OOPEN,IOPEN,OCLOSE. DER HANDLER UND C SPEICHER ZUWEISUNG IST DYNAMISCH, D.H. DASS DIE VER- C SCHIEDENE FUNKTIONEN JENACHDEM DEN FREIEN SPEICHER VER- C GROESSERN ODER VERRINGERN. C C HANDHABUNG VON USR3 : C C 1.ALLGEMEINER AUFRUF C C CALL USR3 (IDEV,NAME,IFUNC,ISTAT) C C 2. PARAMETER C IDEV : LOGISCHE GERAETE-# WIE NORMALERWEISE FRUN C ANGEGEBEN,ZULAESSIG 1-9. C NAME: GERAETE-NAME:FILENAME.EXTENSION NACH OS/8 C -KONVENTION,ABGESPEICHERT IM 6A3-FORMAT. C STRINGS SIND ZULAESSIG,'@' UND SPACES C WERDEN IGNORIERT.WIRD KEIN GERAET ANGEGEBEN, C SO WIRD 'DSK:' ANGENOMMEN. C IFUNC : VON USR3 AUSZUFUEHRENDE FUNKTION C 1 : LOGISCHES GERAET FREI MACHEN (=RELEASE) C 2 : FILE OEFFNEN FUER LESEN (=IOPEN) C 3 : FILE OEFFNEN FUER AUSGABE (=OOPEN) C 4 : AUSGABE-FILE SCHLIESSEN (=OCLOSE) C DIE FILE NAME DIE FUER EIN <OCLOSE> OPERATION C VERWENDET WIRD MUSS MIT DERJENIGE DER FUER C EIN <OOPEN> VERWENDET WURDE UEBEREINSTIMMEN. C EIN <OCLOSE> MIT LAENGE 0 ODER AN EIN EINGABE C FILE <IOPEN> WIRD DIESER FILE NAME VOM C DIRECTORY ENTFERNEN. C ISTAT : - EIN AUFRUFSWERT .GE. 0 VERHINDERT DIE C GERAETESTEUERUNG (FORMS CONTROL FRUN/C), C EIN AUFRUFSWERT .LT. 0 ERLAUBT DIE STEUERUNG. C (ABS(ISTAT)-1) IST DIE GEWUENSCHTE DATEILAENGE. C - ZURUECKGEGEBEN WERDEN ENTWEDER EIN C FEHLERKODE ODER DATEI INFORMATION. C WENN KEINE FEHLER AUFTRETEN WIRD ISTAT C GLEICH DATEILAENGE (FUER <IOPEN>) ODER C GLEICH MAX. DATEIPLATZ (FUER <OOPEN>) C GESETZT. (<RELEASE> UND <OCLOSE> GEBEN 0 ZURUECK) C WENN FEHLER WIRD ISTAT GLEICH DEN NEGA- C TIVEN FEHLERZAHL GESETZT. C C FEHLER ZAHLEN: C -1 : FUNKTION NICHT ERLAUBT FUER DIESE LOGI- C SCHE EINHEIT. (Z.B. OOPEN AUF BESETZTER C KANAL) RELEASE IST IMMER ERLAUBT. C -2 : LOGISCHE EINHEIT NICHT ZWISCHEN 1-9. C -3 : SYNTAX FEHLER IN DEV:NAME.EX C -4 : NICHT GENUG SPEICHER VORHANDEN. ES SIND C MINDESTENS 2 SEITEN NOETIG FUER DIE C FUNKTIONEN 2,3 UND 4. C -5 : OS/8 GERAET EXISTIERT NICHT. C -6 : DATEI NICHT GEFUNDEN, OFFENE DATEI AUF C GERAET ODER GERAET VOLL. C -7 : GERAET SYS: SCHREIBE GESPERRT. C -10 : LESE ODER SCHREIBE FEHLER AUF SYS: C C 3. BEMERKUNGEN. C C A - DATEIEN DIE IM PROGRAMM EROEFFNET WURDEN MUESSEN AUCH C VOM PROGRAMM GESCHLOSSEN WERDEN. DIEJENIGE DIE DEM C COMMAND-DECODER ANGEGEBEN WURDEN, WERDEN GEGEBENEN- C FALLS BEI 'CALL EXIT' GESCHLOSSEN. C B - DIE LOGISCHE GERAETEN 1-4 SIND NICHT WAERMSTENS C EMFOHLEN, DA DIE ZUGEHOERIGEN FRUN INTERNE HANDLERS C NACHTRAEGLICH NICHT MEHR AKTIVIERT WERDEN KOENNEN. C SONST VERHALTEN SIE SICH WIE DIE GERAETE 5-9. C C - DIE 'RELEASE' FUNKTION ERLAUBT ES EIN LOGISCHER GE- C RAET ZU ENTFERNEN WENN DEN FREIEN SPEICHER AUF 0 C ZUSAMMENGESCHRUMPFT IST. DIESE FUNKTION WIRD SONST C HAUPTSAECHLICH FUER DAS WIEDEREROEFFNEN VON EINGABE C KANAELE GEBRAUCHT: C IOPEN 1 XYZ..PROGRAMM..EOF..RELEASE..IOPEN 1 ZYX.. C D - DAS NORMALE VERFAHREN FUER DAS ENTFERNEN EINER DATEI C (DELETE) IST: C RELEASE 5...IOPEN 5 XYZ...OCLOSE 5 XYZ... C E - U S R BESTEHT AUS ZWEI TEILEN: C USRS3 (FPP TEIL) (1000 WORTE) DARF IN OVERLAY SEIN. C USR8 (PDP TEIL) (1000 WORTE) MUSS IN MAIN SEIN. C F - EINE LEICHT GEAENDERTE VERSION VON 'FRUN' MUSS MIT- C VERWENDET WERDEN. DIESE VERSION WIRD DURCH DIE EIN- C ZELNE BUCHSTABE -U- IN IHRE VERSION NUMMER GEKENN- C ZEICHNET. (FRUN V40XYZ U) <--- C C DIMENSION XX(10,20) REAL NAME(6) C WRITE(0,1000) 1000 FORMAT(//,' TEST USR3-Routine',//) C 1 WRITE(0,1010) 1010 FORMAT(/,' Befreien(=1), Lesen(=2), Schreiben(=3) oder Schliessen $(=4) ? '$) READ(0,1020)JGO 1020 FORMAT(I1) IF(JGO.EQ.0)STOP IF (JGO.GT.4) GOTO 1 GOTO (100,200,300,400),JGO C 100 WRITE(0,1030) 1030 FORMAT(' Kanal :'$) READ(0,1040) NDEV 1040 FORMAT(I2) IERR=0 CALL USR3(NDEV,NDEV,1,IERR) IF (IERR.LT.0)GOTO 500 GOTO 1 C 200 WRITE(0,1050) 1050 FORMAT(' Kanal, Forms/Dateilaenge, Geraet:Dateiname ? '$) READ(0,1060)NDEV,IERR,NAME 1060 FORMAT(I2,I5,6A3) CALL USR3(NDEV,NAME,2,IERR) IF (IERR.LT.0) GOTO 500 WRITE(0,1070) IERR 1070 FORMAT(' Datei Laenge ',I4,' Bloecken'/) READ(NDEV,1080)IANZ 1080 FORMAT(I4) DO 50 K=1,IANZ READ(NDEV,1090)T 1090 FORMAT(F8.0) WRITE(0,1100)T 1100 FORMAT(X,F8.0) 50 CONTINUE GOTO 1 C 300 WRITE(0,1050) READ(0,1060)NDEV,IERR,NAME WRITE(0,1110) 1110 FORMAT(/,' Wieviele Werte schreiben ?'$) READ(0,1080) IANZ CALL USR3(NDEV,NAME,3,IERR) IF (IERR.LT.0) GOTO 500 WRITE(0,1070)IERR WRITE(NDEV,1080)IANZ DO 30 K=1,IANZ T=K**2 WRITE(NDEV,1090)T 30 CONTINUE GOTO 1 C 400 WRITE(0,1050) READ(0,1060)NDEV,IERR,NAME ENDFILE NDEV IERR=0 CALL USR3(NDEV,NAME,4,IERR) IF (IERR.GE.0) GOTO 1 C 500 IERR=-IERR WRITE(0,1120) IERR 1120 FORMAT(' Fehler-Kode ',I4) GOTO 1 C END