FTN4 PROGRAM QY24(5,90),92069-16060 REV.2001 791008 C REV.2001 - DOCUMENTATION CHANGE C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18087 C RELOC: 92069-16060 C C C************************************************************ C C C QUERY SUBSYSTEM MAIN MODULE C COMMAND INTERPRETER C C LOGICAL IFTTY INTEGER EDITOR(3) INTEGER IERR5(7) INTEGER ISTAT(10) INTEGER IERR2(9) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ C C DATA IERR2/2H I,2HNV,2HAL,2HID,2H R,2HEQ,2HUE,2HST,2H / DATA IERR5/2H S,2HYN,2HTA,2HX ,2HER,2HRO,2HR / DATA EDITOR/2HED,2HIT,2HR / C C C C C C C C C C C BEGIN C C C EXECUTE C C SEE IF DEFAULT OF "EDITR" IS REQUESTED C C PARAMETER 1 - INPUT LU C PARAMETER 2 - MAXIMUM LINE C PARAMETER 3 - NODE LOCAL TO THE EDITR C PARAMETER 4 - NODE REMOTE TO THE EDITR, LOCAL TO USER C PARAMETER 5 - LU NUMBER TO APPEND TO THE EDITRTO USER C CALL SFILL(IMA,1,6,40B) IF(S.NE. 5) GOTO 560 CALL SMOVE(EDITOR,1,6,IMA,1) ISTAT(1) = INLU ISTAT(2) = 0 ISTAT(3) = NODE(IDMY) ISTAT(4) = RMOTE ISTAT(5) = INLU GOTO 570 C C GET NAME OF PROGRAM C 560 CONTINUE CALL LSCAN(IB,I,J,K) IF(K .NE. 2) GOTO 7010 CALL SMOVE(IB,I,J,IMA,1) C C PASS THE ORIGINAL PRAMETERS C ISTAT(1) = INLU ISTAT(2) = ILP ISTAT(3) = ITTY ISTAT(4) = ECHO ISTAT (5) = 0 C C XQPRG RENAMES, LOADS AND EXECUTES A PROGRAM C C PARAMETERS: C C DCB THAT XQPRG USES TO FIND THE PROGRAM C EXEC CALL (DO NOT SET THE NO ABORT BIT) C NAME OF PROGRAM C ARRAY CONTAINING THE 5 RMPAR PARAMETERS C ARRAY CONTAINING THE PARAMETER STRING C LENGTH OF STRING( MINUS FOR BYTES, PLUS FOR WORDS) C RETURN PARAMETER LIST (MUST NOT BE SAME ARRAY AS INPUT C PARAMETER LIST) C ERROR WORD SCHEDULING ERROR CODE) C 570 CALL XQPRG(IDCB(2),23,IMA,ISTAT,PARM,-LPARM,ISTAT(6),IERR) IF(IERR .NE. 0) GOTO 7030 20 CONTINUE SNAM(2) = 2H CALL LOAD(SNAM) C C SYNTAX ERROR C 7010 CONTINUE CALL SFILL(IMA,1,72,40B) CALL QRIO(2,ITTY,IB,-IEND) IF(I .GT. 72) I = I - I/72*72 CALL SPUT(IMA,I,136B) CALL QRIO(2,ITTY,IMA,-I) CALL ERIO(2,ITTY,IERR5,7 ) GOTO 20 C C IVALID REQUEST C 7030 CONTINUE CALL ERIO(2,ITTY,IERR2,9) GOTO 20 END