*DECK             FILTRD
USETEXT   TSOURCE 
USETEXT   TSYMCNS 
USETEXT   TCEXECQ 
USETEXT   TCOM37Q 
USETEXT   TCOM39Q 
USETEXT   TCOM78Q 
USETEXT   TCEXEC
USETEXT   TC7DECS 
PROC FILTRD((I),(J));  #  I= TRIAD INDEX, J= SYMBOL TABLE POINTER      #
                                        #MOVES INFORMATION FROM A      #
                                        # SYMBOL TABLE ENTRY INTO A    #
                                        # TRIAD.                       #
BEGIN 
  
*CALL COMEX 
  
  
  
  
    XREF PROC DALOC;
    XREF PROC FIND; 
    XREF PROC GANAL;
    XREF PROC SYMABTL;                                                   FILTRD 
    XDEF FUNC KFIND;
    XDEF FUNC PLABL;
    XREF PROC POST; 
  
      DEF J826 #826#;              # SYMABT DIAGNOSTIC 826             # FILTRD 
  
  
  
    ITEM I,J,K,L,M; 
CONTROL EJECT;
      FUNC PLABL; 
  
#     PLABL - CREATE A SYMBOL TABLE ENTRY OF CLAS "LABL" AND RETURN    #
#     POINTER TO IT                                                    #
  
    BEGIN 
    ITEM I; 
    POST(NONAM,LABL$W,I); 
    CLAS[I]=S"LABL";
    LREF[I]=1;
    PLABL=I;
    END 
  
  
  
  
  
  
  
  
  
FUNC KFIND(C); #RETURNS VALUE OF CLAS"CONS" ENTRY#
    BEGIN 
    ITEM C; #PTR TO CLAS"CONS ENTRY#
    ITEM I,J; 
    FIND(C,J);
    KFIND=CONS[J];
    END 
      CONTROL EJECT;
    #THE FOLLOWING TRIAD FIELDS ARE SET:  
         AC$S,BASD,CTYP,EFBT,EFBY,ENBT, 
         ENBY,KFLG,MEMR,SFLG,SHRT,
         TTST,VFLG,$CLG,$IGN,$TST#
    #DEFAULT FOR ABOVE ASSUMED TO BE ZERO#
  
  
    MEMR[I]=J;
KLABL:  
    K=CLAS[J];
JLABL: #INSERTED TO HANDLE J-TEMPS# 
    IF ICOTYP[K] THEN 
         BEGIN #CLAS=ARRY,CONS,DATA,FUNC,LOOP,STRG,TEMP,TITM# 
      IF K EQ QCLAS"TEMP" 
       AND NOT TPFO[J] THEN 
         DALOC (J)  ;   # ALLOCATE PASS 1 TEMP  # 
         L=TYPE[J]; 
         $IGN[I]=SIGN[J]; 
         VFLG[I]=TPLNB[L];
         IF BITATR[L] THEN #NBIT SIGNIFICANT# 
              BEGIN #TYPE=IGR,REAL,FIX,DBL,BOOL,STTS,USI# 
              ENBT[I]=NBIT[J];
              EFBT[I]=FBIT[J];
              ENBY[I]=(NBIT[J]+5)/6;
              EFBY[I]=10-ENBY[I]; 
      $CLG[I] = 0; # NOT USED BY SYMPL# 
              AC$S[I]=S"EQ";
              IF K EQ QCLAS"CONS" THEN
                   BEGIN
                   KFLG[I]=T; 
                   TTST[I]=T; 
                   KONS[I]=KFIND(J);
                   IF L EQ QTYPE"BOOL" THEN RLTL[I]=RCOM[KONS[I]+6];
                   GANAL(J,VRAI);                                        JANDRE 
                   RETURN;
                   END
              IF NOT SIGN[J] THEN TTST[I]=T;
      IF K EQ QCLAS"TITM" THEN BEGIN
                        IF PACK[J] NQ QPACK"NONE" AND NBIT[J] NQ 60 THEN
                             BEGIN
                             AC$S[I]=S"LS"; 
                             IF L EQ QTYPE"BOOL" AND NBIT[J] EQ 1 THEN
                             $TST[I]=T; 
                             END
                        IF TTYP[MAMA[J]] EQ S"BASED" THEN BASD[I]=T;
                        END 
              RETURN; 
              END #BITATR#
         CTYP[I]=TPHTO[L];
         IF BYTATR[L] THEN #NBYT=NUMBER OF CHARACTERS#
              BEGIN #TYPE=HLTH,TRAN,EBCD,OCT# 
                   ADJF[I]=T; 
                   ENBY[I]=NBYT[J]; 
                   IF ENBY[I] LS 10 THEN SHRT[I]=T; 
                   AC$S[I]=S"EQ"; 
                   TTST[I]=T; 
                   IF K EQ QCLAS"CONS" THEN 
                        BEGIN 
                        KFLG[I]=T;
                        KONS[I]=KFIND(J); 
                        GANAL(J,VRAI);                                   JANDRE 
                        END 
                   IF ICOSUBS[K] THEN 
                        BEGIN #CLAS=ARRY,STRG,TITM# 
                        IF TTYP[MAMA[J]] EQ S"BASED" THEN BASD[I]=T;
                        END #SUBSCRIPTED DATA#
                   EFBT[I]=FBIT[J]; 
                   ENBT[I]=6*ENBY[I]; 
                   EFBY[I]=EFBT[I]/6; 
          IF ENBY[I]+EFBY[I] GR 10 THEN AC$S[I]=S"GR";
              ELSE IF ENBY[I] LS 10 THEN AC$S[I]=S"LS"; 
                   RETURN;
              END 
        SYMABTL(J826,"FALL THROUGH( FILTRD) LINE XXXXX",31,LINUM);       FILTRD 
ENTRY PROC FILLTR((I)); 
    J=MEMR[I];
    GOTO KLABL; 
         END #ICOTYP# 
    IF K EQ QCLAS"DUMY" THEN
         BEGIN #DUMY ENTRY# 
         IF RLNK[J] EQ 0 THEN                                            L428 
           BEGIN                                                         L428 
           MEMR[I] =J;                                                   L428 
           RETURN;                                                       L428 
           END                                                           L428 
         J=RLNK[J]; 
         MEMR[I]=J; 
         GOTO KLABL;
         END
    IF K EQ QCLAS"TABL" AND TTYP[J] EQ QTTYP"BASED" THEN BASD[I]=T; 
END 
TERM
