*DECK             FRMNME
USETEXT   TSOURCE 
USETEXT   TSYMCNS 
USETEXT   TCEXECQ 
USETEXT   TCEXEC
PROC FRMNME(A,B); 
     ITEM A,B;
$BEGIN
  BEGIN 
  
  
  
  
#     COMDECKS                                                         #
  
*CALL COMEX 
  
*CALL     DMPCM6
  
  
  
  
  
         XREF PROC BINOCT;
         XREF PROC CHRCHR;
         XREF PROC FIND;
  
         DEF  NINSC #41# ;
  
         ARRAY [0:NINSC] S(1);
           ITEM LSTINS C(0,0,BYTNWD) =[ 
              "NULL  " ,
              "IRX   " ,
              "IFX   " ,
              "IDX   " ,
              "RIX   " ,
              "RFX   " ,
              "RDX   " ,
              "FIX   " ,
              "FRX   " ,
              "FDX   " ,
              "DIX   " ,
              "DRX   " ,
              "DFX   " ,
              "INPUT " ,
              "OUTPUT" ,
              "OPNI  " ,
              "OPNO  " ,
              "SHTI  " ,
              "SHTO  " ,
              "LOC   " ,
              "BIT   " ,
              "BYTE  " ,
              "POS   " ,
              "NENT  " ,
              "ENTRY " ,
              "ODD   " ,
              "PFUN  " ,
              "CIX   " ,
              "CRX   " ,
              "CDX   " ,
              "ICX   " ,
              "RCX   " ,
              "DCX   " ,
            "FFX   " ,
            "CHAR  " ,
            "MANT  " ,
            "BITY  " ,
  "QFNBR$"
           ] ;
  
         ARRAY XX[0:0] S(1);
              ITEM CLSLST C(0,0,BYTNWD);
         ITEM D1   C(BYTNWD)="NAME";
         ITEM D2   C(BYTNWD)="DATA";
         ITEM D3   C(BYTNWD)="ARRY";
         ITEM D4   C(BYTNWD)="TABL";
         ITEM D5   C(BYTNWD)="CONS";
         ITEM D6   C(BYTNWD)="TEMP";
         ITEM D7   C(BYTNWD)="LABL";
         ITEM D8   C(BYTNWD)="CLOS";
         ITEM D9   C(BYTNWD)="PROC";
         ITEM D10  C(BYTNWD)="FUNC";
         ITEM D11  C(BYTNWD)="SWCH";
         ITEM D12  C(BYTNWD)="FILE";
         ITEM D13  C(BYTNWD)="EMPT";
         ITEM D14  C(BYTNWD)="OVER";
         ITEM D15  C(BYTNWD)="DUMY";
         ITEM D16  C(BYTNWD)="PROG";
         ITEM D17  C(BYTNWD)="DEF ";
         ITEM D18  C(BYTNWD)="SLC ";
         ITEM D19  C(BYTNWD)="STRG";
         ITEM D20  C(BYTNWD)="INSC";
         ITEM D21  C(BYTNWD)="MON ";
         ITEM D22  C(BYTNWD)="BPAR";
         ITEM D23  C(BYTNWD)="TITM";
         ITEM D25  C(BYTNWD)="SCON";
         ITEM D26  C(BYTNWD)="COMM";
         ITEM D27  C(BYTNWD)="FPAR";
         ITEM D28  C(BYTNWD)="STSL";
         ITEM D29  C(BYTNWD)="VALU";
         ITEM D30  C(BYTNWD)="SNAM";
         ITEM D31  C(BYTNWD)="ADCN";
         ITEM D32  C(BYTNWD)="DTXT";
         ITEM D33  C(BYTNWD)="TEXT";
         #REAL END OF ARRAY XX# 
         ITEM I,J,K,M,N;
         ARRAY TMPA [1:5] S(1); 
              ITEM TMPN C(0,0,BYTNWD);
         I=B; 
         IF CLAS[A] EQ S"NULL" THEN                              BEGIN
FRMN1:        CHRCHR(PL,I,"NULL",4);
              RETURN;                                            END
         IF CLAS[A] EQ S"EMPT"
         THEN 
           BEGIN
           CHRCHR (PL,I,CLSLST[CLAS[A]],4); 
           RETURN;
           END
         CHRCHR(PL,I,CLSLST[CLAS[A]],4);
         I=I+4; 
         CHRCHR(PL,I,":",1);
         I=I+1; 
         IF CLAS [A] EQ S"INSC" THEN                              BEGIN 
              IF FNBR [A] GR NINSC THEN 
                   BINOCT(PL,I,FNBR[A],6);
              ELSE CHRCHR(PL,I,LSTINS[FNBR[A]],6);
              RETURN;                                            END
         IF  CLAS[A] EQ S"SNAM" 
         THEN 
           BEGIN
           CHRCHR(PL,I,NAME[A],NCHR[A]);
           RETURN;
           END
  
         IF NNAM[A] THEN                                         BEGIN
              CHRCHR(PL,I,"(NONE)",6);
              RETURN;                                            END
         FIND(A,J); 
         IF CLAS[A] NQ S"CONS" THEN                              BEGIN
              IF NCHR[J] GR NMAX THEN K=NMAX; 
              ELSE K=NCHR[J]; 
FRMN2:        N=(K+BYTNWD-1)/BYTNWD;
              FOR M=1 STEP 1 UNTIL N DO 
                   TMPN[M]=NAME[J+M-1]; 
              CHRCHR(PL,I,TMPA,K);
              RETURN;                                            END
         IF TYPE[A] EQ S"NULL" THEN GOTO FRMN1; 
         IF TYPE[A] EQ S"HLTH" THEN                              BEGIN
              K=NBYT[A] ; 
              IF K GR NMAX THEN K=NMAX; 
              GOTO FRMN2;                                         END 
         M=BITNWD/3;
         N=BITNWD-6;
         FOR K=0 STEP 3 UNTIL N DO                               BEGIN
              IF B<K,3>CONS[J] NQ 0 THEN GOTO FRMN3; M=M-1;      END
FRMN3:   BINOCT(PL,I,CONS[J],M);
         RETURN;
  END 
$END
 TERM 
