*DECK             XRDEF 
USETEXT   TSOURCE 
USETEXT   TSYMCNS 
USETEXT   TCEXECQ 
USETEXT   TSYMC5Q 
USETEXT   TCEXEC
USETEXT   TSYMC5
PROC XRDEF (XLINK,XCARD); 
     BEGIN
               #THIS ROUTINE INCLUDES ALL OF THE ENTRY POINTS CALLED
               FROM PF1 IN ORDER TO MAKE ENTRIES IN THE 
               CROSSREFERENCE LIST.   THE ROUTINE HAS THE 
          FOLLOWING ENTRIES:  
               1.   XRDEF(LINK,CARD)
                         MAKES AN ENTRY OF TYPE DEFINE FOR THE ENTRY
                         AT SYM0 LOCATION LINK, FOR LINE NUMBER CARD. 
               2.   XRUSE(LINK,CARD)
                         MAKES AN ENTRY OF THE TYPE USE--SAME PARAMS AS 
                         ABOVE. 
               3.   XRSET(LINK,CARD)
                         MAKES AN ENTRY OF TYPE SET.  SAME AS ABOVE.
               4.   XUSE(COUNT) 
                         MAKES A USE ENTRY FOR THE CONSTRUCT
                         SPECIFIED BY COUNT AT ITS CARD NUMBER. 
                         TO FIND THE CONSTURCT, THE ROUTINE 
                         GOES BACK IN THE CONSTRUCT STRING
                    FROM POZN, COUNT TIMES. 
               5.   XSET(COUNT) 
                         MAKES A SET ENTRY, AS ABOVE9 
               #
  
  
  
                                                  # HOSLER# 
  
*CALL COMEX 
  
DEF BUFMAX #100#; 
XREF PROC PTCRF;
XREF PROC PNAM; 
  
     DEF ROPTN #B<41>OPTION EQ 0#;
  
  
      DEF  CRF$ARRAY  # ARRAY CRBUF[0:BUFMAX] S(1)#;
  
*CALL  COM19A 
  
      ITEM  XLINK    I;            # PARAM STP TO XREFED ENTITY        #
      ITEM  XTYPE    S:QCRFTYP;    # PARAM, KIND OF ENTRY              #
      ITEM  XCARD    I;            # PARAM, CARD NO.                   #
      ITEM  BUFIX    I;            # INDEX INTO CRBUF                  #
      ITEM  R        I;            # INDEX                             #
      ITEM  S        I;            # INDEX                             #
  
  
          IF ROPTN THEN RETURN; 
          XTYPE=S"DEF"; 
          GOTO GO;
  
ENTRY PROC XRSET(XLINK,XCARD);
          IF ROPTN THEN RETURN; 
          XTYPE=S"SET"; 
          GOTO GO;
  
ENTRY PROC XRUSE(XLINK,XCARD);
          IF ROPTN THEN RETURN; 
           XTYPE = S"REF";
          GOTO GO;
  
ENTRY PROC  XRATRB (XLINK,XCARD) ;
          IF ROPTN THEN RETURN ;
          XTYPE = S"ATRB" ; 
          GOTO GO ; 
ENTRY PROC XUSE(P); 
      ITEM  P         I;           # PARAM                             #
  
          IF ROPTN THEN RETURN; 
           XTYPE = S"REF";
          GOTO XSETL; 
  
ENTRY PROC XATT (P);
         XREF PROC XATT;
         IF ROPTN THEN RETURN;
         XTYPE = S"ATRB"  ; 
         GOTO XSETL;
  
ENTRY PROC XSET(P); 
          IF ROPTN THEN RETURN; 
          XTYPE=S"SET"; 
  
XSETL:    R=POZN; 
          FOR S=1 STEP 1 UNTIL P DO R=BLNK[R];
          CRLIN[BUFIX]=CRNO[R]; 
          CRLNK[BUFIX]=CSRF[R]; 
          GOTO TYP; 
GO:  CRLIN[BUFIX]=XCARD;
          CRLNK[BUFIX]=XLINK; 
TYP:      CRTYP[BUFIX]=XTYPE; 
          BUFIX=BUFIX+1;
          IF BUFIX EQ BUFMAX THEN                 #TIME TO WRITE OUT# 
               BEGIN
WRTE:          PTCRF(CRBUF,BUFIX);
               BUFIX=0; 
               END
OUT:      RETURN; 
  
ENTRY PROC XRFINT;                 #INITIALIZATION--CALLED FROM INIT1#
FOR BUFIX=0 STEP 1 UNTIL BUFMAX DO CRBUFWORD[BUFIX]=0;
          BUFIX=0;
          RETURN; 
  
ENTRY PROC XRFCLS;                 # CALLED BY PF12 OR PF13 WHEN *TERM*#
                                   # OCCURS TO POST NAME:(GLOBAL) INTO #
                                   # THE SYMBOL TABLE, SET SCPN[1], AND#
                                   # ENSURE CRF BUFFER IS FLUSHED      #
  
ITEM GLOBAL C(10) = "(GLOBAL)";    # NAME FOR NAME:(GLOBAL) S.T. ENTRY #
ITEM GLOLOC I;                     # TEMP FOR INDEX OF NAME:(GLOBAL)   #
  
C<8,1>GLOBAL = 0;                  # APPEND ZERO CHAR TO NAME  (MAPCRF #
                                   # DOES THIS FOR OTHER S.T. NAMES)   #
PNAM (GLOBAL,8,GLOLOC);            # POST NAME:(GLOBAL)                #
SCPN[1] = GLOLOC;                  # SET SCOPE NAME TABLE ENTRY [1]    #
IF BUFIX NQ 0 
THEN                               # FLUSH CRF BUFFER IF NECESSARY     #
  BEGIN 
  GOTO WRTE;
  END 
  
END 
TERM
