File: USRTES.FT of Disk: Disks/MyPDP/m8-1-rka1-rkb1
(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