C V1A Edit #55 6-Jun-83 Autor: -tf- File: [TF.KUSTER]SSEC.FOR C C S S E C . F O R : READ / WRITE FLOPPY C C *** SINGLE SECTORS / SINGLE OR DOUBLE DENSITY *** C C C CALLING SEQUENCE : C C CALL SSEC (IBUF,ISEC,ITR,IFUNC,IUNIT,IDENS,IERR) C CALL SSEC (IBUF,ISECT,ITRACK,IFUNC,IUNIT,IDENS,IERR) C C IBUF = BUFFER (ARRAY) C ISECT = SECTOR # C ITRACK = TRACK # C IFUNC = FUNCTION : READ=0, WRITE=1 C IUNIT = DRIVE # (0/1) C IDENS = DENSITY (0 = SINGLE , 1 = DOUBLE) C IERR = ERROR C = 0 OK. C = 1 ISEC=0 OR ISEC>26 C = 2 ITR >76 C = 3 IDENS NOT 0 OR 1 C = 4 BAD FUNCTION C C ICHAN = CHANNEL FROM $ASSIGN C SUBROUTINE SSEC (IBUF,ISECT,ITRACK,IFUNC,IUNIT,IDENS,IERR) C INTEGER*2 IBUF(256),ISECT,ITRACK,IFUNC,ICHAN,IUNIT,IDENS,IERR INTEGER*4 SYS$QIOW,IDISKADR INTEGER*2 ITWOBYTE,IDRIVE BYTE LOCBUF(256),TWOBYTE(2) EQUIVALENCE (ITWOBYTE,TWOBYTE(1)) C COMMON /DY/ICHAN,IDRIVE C INCLUDE '($IODEF)' INCLUDE '($SSDEF)' C IERR=0 IDISKADR=(ITRACK*65536)+ISECT NBYTE=128 IF (IDENS.EQ.1) NBYTE=256 C IF (IFUNC.EQ.0) GOTO 100 IF (IFUNC.EQ.1) GOTO 200 IERR=4 STOP '?CMPVAX-F-Internal IFUNC Error' C 100 CONTINUE ISTATUS=SYS$QIOW(,%VAL(ICHAN),%VAL(IO$_READPBLK) 1,,,,LOCBUF,%VAL(NBYTE),%VAL(IDISKADR),,,) IF (.NOT.ISTATUS) TYPE 101,ISTATUS 101 FORMAT(' ?CPMVAX-W-Read Status',Z,' (hex)') IF (ISTATUS .EQ. SS$_NOPRIV) TYPE 102,IDRIVE 102 FORMAT(' Did you MOUNT/FOREIGN DY',I1,': ?') IF (.NOT.ISTATUS) STOP '?CPMVAX-F-Read Error' C DO 110 I=1,256 110 IBUF(I)=LOCBUF(I) .AND. "377 ! LOW BYTE ONLY GOTO 999 C 200 CONTINUE C TYPE *,'?CPMVAX-W-Write not yet implemented' C GOTO 999 C DO 210 I=1,256 ITWOBYTE=IBUF(I) .AND. "377 ! LOW BYTE ONLY LOCBUF(I)=TWOBYTE(1) 210 CONTINUE C ISTATUS=SYS$QIOW(,%VAL(ICHAN),%VAL(IO$_WRITEPBLK) 1,,,,LOCBUF,%VAL(NBYTE),%VAL(IDISKADR),,,) IF (.NOT.ISTATUS) TYPE *,'?CPMVAX-W-Write Status',ISTATUS IF (.NOT.ISTATUS) STOP '?CPMVAX-F-Write Error' GOTO 999 C 999 RETURN END