C *************** C C MODULE NAME: DBHTRF C C AUTHOR: JW DRUMMOND C C DATE: OCT 15 1976 C C MODULE FUNCTION: C ACCEPTS REQUESTS FROM APPLICATION PROGRAMS THRU C THE SEND-RECEIVE QUEUE. COPYS APPROPRIATE ARRAYS C FROM THE CALLING TASK SPACE. DISPATCHES THE C REQUEST TO THE APPROPRIATE SUBROUTINE. WHEN COMPLETE, C THE APPROPRIATE ARRAYS ARE RESTORED AND THE CALLING C TASK IS RESUMED. C C C *************** PROGRAM DBHTRF INCLUDE '[230,100]COMMON.FTN' INCLUDE '[230,100]DBFCB.FTN' INCLUDE '[230,100]COMEQUIV.FTN' C INTEGER*4 DBORDS ! OLD DBH READS COUNT INTEGER*4 DBOWTS ! OLD DBH WRITES COUNT INTEGER DBHMSG(3) INTEGER FCBADR INTEGER DBIRDS INTEGER DBIWTS EQUIVALENCE (DBHMSG(1),FCBADR) EQUIVALENCE (DBHMSG(2),DBIRDS) EQUIVALENCE (DBHMSG(3),DBIWTS) C ********************* START OF PROGRAM ****************************** C C C CALL TRACE ROUTINE TO SAVE STACK POINTER AND PC C IN CASE A RESTART IS NEEDED. C CALL TRACE(1) C 100 DO 101 I=1,4 DBIMSG(I)=0 !CLEAR INPUT MESSAGE 101 CONTINUE ERR=0 IF(ENDDAY.LT.2) GO TO 102 CALL EXIT C 102 CALL VRECSP(,DBIMSG(1),1,DBITI,,ERR) IF(ERR.NE.1) GO TO 100 FCBADR=DBIFCB DBORDS=DBHRDS DBOWTS=DBHWTS C C COPY USER DBFCB IRREGARDLESS 110 CALL COPY(DBITI,DBITSK(1),DBIFCB,57,UFCB1(1),ERR) IF(ERR.LT.0) CALL DBHABT DBHCLL=DBHCLL+1 C COPY FILE BUFFER IF REQUIRED IF((UFCB1(FCBFCD).EQ.4).OR.(UFCB1(FCBFCD).EQ.7).OR. * (UFCB1(FCBFCD).EQ.17).OR. * (UFCB1(FCBFCD).EQ.8).OR.(UFCB1(FCBFCD).EQ.20)) GO TO 150 CALL COPY(DBITI,DBITSK(1),UFCB1(FCBBUF),256,UBUF1(1),ERR) IF(ERR.LT.0) CALL DBHABT C COPY RECORD BUFFER IF INSERT 150 IF((UFCB1(FCBFCD).NE.8)) GO TO 200 IRECSZ=FILDFT(RECSIZ,UFCB1(FCBFLN))/2 CALL COPY(DBITI,DBITSK(1),UFCB1(FCBNEW),IRECSZ,UREC(1),ERR) IF(ERR.LT.0) CALL DBHABT C C CALL APPROPRIATE HANDLER ROUTINE C AS PER FUNCTION CODE C 200 IF(UFCB1(FCBFCD).NE.4) GO TO 230 CALL DBHGET(UFCB1(1)) GO TO 800 230 IF(UFCB1(FCBFCD).NE.6) GO TO 240 CALL DBHMOD(UFCB1(1)) GO TO 800 240 IF((UFCB1(FCBFCD).NE.7).AND.(UFCB1(FCBFCD).NE.17)) GO TO 250 CALL DBHFND(UFCB1(1)) GO TO 800 250 IF(UFCB1(FCBFCD).NE.8) GO TO 270 CALL DBHINS(UFCB1(1)) GO TO 800 270 IF(UFCB1(FCBFCD).NE.10) GO TO 280 CALL DBHDEL(UFCB1(1)) GO TO 800 280 IF(UFCB1(FCBFCD).NE.20) GO TO 290 CALL DBHPTR GO TO 800 290 UFCB1(FCBRCD)=12 C C C RESTORE DBFCB AND MAYBE BUFFER C THEN WAKE UP USER TASK C 800 CALL RESTOR(DBITI,DBITSK(1),DBIFCB,57,UFCB1(1),ERR) IF(ERR.LT.0) CALL DBHABT IF((UFCB1(FCBFCD).EQ.6).OR.(UFCB1(FCBFCD).EQ.20).OR. * (UFCB1(FCBFCD).EQ.10)) GO TO 900 CALL RESTOR(DBITI,DBITSK(1),UFCB1(FCBBUF),256,UBUF1(1),ERR) IF(ERR.LT.0) CALL DBHABT 900 DBIRDS=DBHRDS-DBORDS DBIWTS=DBHWTS-DBOWTS IF (DBIRDS.LT.0)DBIRDS=(DBIRDS+32767)+1 IF (DBIWTS.LT.0)DBIWTS=(DBIWTS+32767)+1 C C CHANGE ,1, TO ,3, TO SEND RDS AND WTS COUNT BACK TO C APPLICATIONS TASK. THIS WILL ALSO REQUIRE CHANGE IN C DBIDBH ROUTINE AND TASK BUILDING EACH APPLICATION PROGRAM. C CALL VSNDRR(DBITSK(1),,DBHMSG,,3,,DBITI,ERR) IF(ERR.LT.0) CALL DBHABT C 999 GO TO 100 !LOOP BACK TO THE BEGINNING END