C SUBROUTINES TO SUPPORT SUBTASKING. THESE SUBROUTINES CALL C MODULES FROM THE LIBRARY LB0:[1,1]TSLIB; THE MODULES IN THAT C LIBRARY ARE TAKEN FROM MARK LEWIS'S SUBTASKING LIBRARY, C MODIFIED SO THAT EACH (INTEGER) FUNCTION RETURNS ITS COMPLETION C CODE IN R0, RATHER THAN IN A SEPARATE ARGUMENT. C C Submitted by: C C R. N. Stillwell C Institute for Lipid Research C Baylor College of Medicine C Houston, Texas 77030 C C (who would be glad to receive comments, suggestions, bug fixes, etc., but C who promises no support whatever). C C Literature reference: C C R. N. Stillwell. A low-overhead laboratory data management system C for the PDP11. Comput. Biomed. Res., 15, 29-38(1982). C C Acknowledgement: C C This software was developed under National Institutes of Health grants C GM-13901 and GM-26611. C C General permission is hereby granted to copy, modify, or distribute this C program, but not for profit. Copyright to this software is and shall C remain in the public domain. C C 25-JAN-82 SPLIT OUT 3 OPERATIONS AS SEPARATE SUBROUTINES C TO ALLOW SMALLER OVERLAYS C C 27-JAN-82 use "standard" common; remove 2nd parameter () C from RUN. C C INITAS SETS UP SUBTASKING TDB (ONLY ONE) C SUBROUTINE INITAS CALL DECTDB(1) RETURN END C C SUBTSK INTERPRETS AND PROCESSES THE USER'S COMMAND. THERE ARE C THREE OF THESE: C C %SUbtask RUn C is a quoted string or the name of a variable C containing a string. This string begins with the name of C the installed task or file to be run: C filename.TSK task file for auto-install and run C ...nam C $$$nam C tsknam task is installed C This is optionally followed by a blank and the remainder C of a command line to be passed to the task; the task will C be able to GETMCR the command line only if type 2 or 3 is used. C C %SUbtask SEnd C is a quoted string or the name of a variable containing C a string which is to be passed to the subtask as a message. C C %SUbtask REceive C is the name of a variable to receive a message from C the subtask. If the length of the resulting variable is 1, C the subtask was never active or has exited without sending C a message; the contents of the variable will be: C '0' subtask successfully terminated with no message C '1' subtask aborted C '2' subtask did not load C '3' subtask is suspended (prob. waiting for message itself) C '4' subtask terminated and chained C Otherwise, if the subtask is suspended, it will be resumed. C If it has not yet sent a message, the calling task will wait C until it does (or until it terminates); the variable will C contain the message, padded with one blank if necessary. C If the subtask was never RUn, an error message will be printed C and the variable will not be stored. C SUBROUTINE SUBTSK(LTRACE,FILERR,EVALER) LOGICAL*1 LTRACE,FILERR,EVALER C INCLUDE 'COMMON.FLX' C C Declare common blocks. C COMMON /TABDAT/ NREC,NCOLS,LENREC,OFFSET,IPTRD,TABREC, 1 DATA,IALT,IDUM INTEGER NREC,NCOLS,LENREC,OFFSET,IPTRD(41),TABREC BYTE DATA(1000) LOGICAL*1 IALT,IDUM !1-82 COMMON /LUN/ INLUN,OUTLUN,TILUN,TABLUN,TAILUN,RDFLUN INTEGER INLUN,OUTLUN,TILUN,TABLUN,TAILUN,RDFLUN COMMON /INPUT/ IREC,INPTR,LLINE,INLINE BYTE INLINE(132) DATA MAXIN/132/ COMMON /OUTPUT/ OUTLIN,OUTPTR,OUTEND BYTE OUTLIN (132) INTEGER OUTPTR,OUTEND DATA MAXOUT /132/ COMMON /FILES/ FILNAM,MAXFNM,MODNAM,LFNAM,FLREC, 1 MAXLVL,INLVL,OLDLVL,ULBUF,CARCTL,TERM 1 ,OUTOPN,TBOPEN C C File stack. C BYTE FILNAM(26,5) DATA MAXFNM/26/ REAL*4 MODNAM(5) !9-OCT-81 RAD50 MODULE NAMES INTEGER LFNAM(5) !LENGTHS OF NAMES C !POINTERS TO START OF CURRENT C !OR NEXT RECORD REAL*4 FLREC(5) !9-OCT-81 CHANGED FROM C !RECORD PTR TO BYTE PTR C D INTEGER IFLREC(2,5) D EQUIVALENCE (IFLREC,FLREC) DATA MAXLVL/5/ INTEGER INLVL !CURRENT LEVEL POINTER INTEGER OLDLVL !PREVIOUS LEVEL POINTER INTEGER ULBUF (7) BYTE CARCTL LOGICAL*1 TERM,OUTOPN,TBOPEN C C Scratch memory. Definitions may differ from subroutine to subroutine, C or may use equivalence statements. C COMMON /SCRATC/ SCRATC BYTE SCRATC (576) C C Local declarations. C LOGICAL*1 QUOTED,TSKACT LOGICAL*1 INVER,VARER INTEGER OPCODE BYTE OPBYTE(2) EQUIVALENCE (OPCODE,OPBYTE) INTEGER RECEIV,RUN,SEND DATA RECEIV,RUN,SEND/'RE','RU','SE'/ BYTE STR1(8) DATA MAXSTR /7/ REAL*8 VARNAM BYTE VBYTE(8) EQUIVALENCE (VARNAM,VBYTE) REAL*8 VARN1 EQUIVALENCE (VARN1,STR1) C C IMPLEMENTATION NOTE: the TDB'S and the variable TSKACT C must be in a root-segment .PSECT. Also, for IAS, if this C module is in an overlay segment, then the root segment must C contain the module PILUN from SYSLIB. C COMMON/SUBCOM/ IDUMM(123),TSKACT C C CODE C EVALER = .FALSE. GET-OPCODE PERFORM-OPERATION RETURN C TO GET-OPCODE IF (INPTR.EQ.0) REPORT-SUBTASK-ERROR C No indirection on opcode CALL GETNAM(0,STR1,MAXSTR,LOPC,FILERR,QUOTED,EVALER) IF (FILERR) RETURN IF (EVALER) RETURN IF (LOPC.LT.2) REPORT-SUBTASK-ERROR DO (I=1,2) OPBYTE(I) = STR1(I).AND."137 FIN C TO PERFORM-OPERATION SELECT (OPCODE) (RECEIV) DO-RECEIVE-OPERATION (RUN) DO-RUN-OPERATION (SEND) DO-SEND-OPERATION (OTHERWISE) REPORT-SUBTASK-ERROR FIN IF (INVER) REPORT-INVALID-OPERAND IF (VARER) REPORT-VARIABLE-ERROR FIN TO DO-RECEIVE-OPERATION IF (.NOT. TSKACT) REPORT-SEND-RECEIVE-ERROR CALL SUBREC(LTRACE,INVER,VARER) FIN TO DO-RUN-OPERATION CALL SUBRUN(LTRACE,INVER,VARER) FIN TO DO-SEND-OPERATION IF (.NOT. TSKACT) REPORT-SEND-RECEIVE-ERROR CALL SUBSEN(LTRACE,INVER,VARER) FIN TO REPORT-SEND-RECEIVE-ERROR WRITE (TILUN,2) 2 FORMAT (' Send/receive error: no subtask is active.') EVALER = .TRUE. RETURN FIN TO REPORT-SUBTASK-ERROR WRITE (TILUN,4) 4 FORMAT (' Invalid subtask operation.') EVALER = .TRUE. RETURN FIN TO REPORT-INVALID-OPERAND WRITE (TILUN,6) 6 FORMAT (' Missing or invalid operand of SUbtask command.') EVALER = .TRUE. RETURN FIN TO REPORT-VARIABLE-ERROR WRITE (TILUN,8) VARNAM 8 FORMAT (' Subtask error: no such variable as: ',A8) EVALER = .TRUE. RETURN FIN END