File: USR.FT of Tape: Sources/Fortran/os8-f4-1
(Source file text)
C C TEST USR-ROUTINE IN F4 27-JUN-80 C C VERFASSUNG: W.V.D.MARK, DP CONSULTING, ZUERICH C VERTRIEB: DATAPLAN GMBH, LAUDA, BRD C C USR ERMOEGLICHT DEN FILE-ZUGRIFF UNTER FORTRAN IV C OHNE FRTS 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 USR : C C 1.ALLGEMEINER AUFRUF C C CALL USR (IDEV,NAME,IFUNC,ISTAT) C C 2. PARAMETER C IDEV : LOGISCHE GERAETE-# WIE NORMALERWEISE FRTS C ANGEGEBEN,ZULAESSIG 1-9. C NAME: GERAETE-NAME:FILENAME.EXTENSION NACH OS/8 C -KONVENTION,ABGESPEICHERT IM 3A6-FORMAT. C STRINGS SIND ZULAESSIG,'@' UND SPACES C WERDEN IGNORIERT.WIRD KEIN GERAET ANGEGEBEN, C SO WIRD 'DSK:' ANGENOMMEN. C IFUNC : VON USR 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 FRTS/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 FRTS 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 USRS (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 'FRTS' MUSS MIT- C VERWENDET WERDEN. DIESE VERSION WIRD DURCH DIE EIN- C ZELNE BUCHSTABE -U- IN IHRE VERSION NUMMER GEKENN- C ZEICHNET. (FRTS V40XYZ U) <--- C C DIMENSION XX(10,20) C WRITE(0,1000) 1000 FORMAT(//,' TEST USR-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 USR(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,G1,G2,G3 1060 FORMAT(I2,I5,3A6) CALL USR(NDEV,G1,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,F1,F2,F3 WRITE(0,1110) 1110 FORMAT(/,' WIEVIELE WERTE SCHREIBEN ?'$) READ(0,1080) IANZ CALL USR(NDEV,F1,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,H1,H2,H3 ENDFILE NDEV IERR=0 CALL USR(NDEV,H1,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