%EXTERNALROUTINE CROSSREF(%STRING(63)INPUT)
%CONSTINTEGER JOBNAMLEN=6,MAXDISP=15,MAXGLOB=255,MAXHASH=4095, %C
   MAXLINE=511,NAMLEN=8,OUTLINE=132,PAGESIZE=4096
%CONSTSTRING(23)VERSION="2.02 07/08/78  (MDB)"
%OWNSTRING(35)HEADER="* VARIABLE CROSS REFERENCE OF FILE "
%OWNSTRING(35)BLANK=""
%OWNSTRING(87)ASTK="*******************************************"
%INTEGER DATASTART,DEND,LENIN,M,MAXNAMES,MAXSTRINGS,MAXUSES
%STRING(31)DATETIME,MEMNAME,NAML,OUTPUT,VNAME
%EXTERNALROUTINESPEC DEFINE(%STRING(63)S)
%EXTERNALINTEGERFNSPEC SMADDR(%INTEGER N,%INTEGERNAME L)
%EXTERNALROUTINESPEC PROMPT(%STRING(15)S)
%EXTERNALSTRINGFNSPEC DATE
%EXTERNALSTRINGFNSPEC TIME
!*
%STRINGFN ITOSTR(%INTEGER I,M)
%STRING(1)SIGN
%STRING(63)S
M=0%IF M<0
%IF I<0%THEN SIGN="-"%AND I=IMOD(I)%ELSE SIGN=" "
S=""
S=TOSTRING(I-I//10*10+'0').S%AND I=I//10%UNTIL I=0
S=SIGN.S
S=" ".S%WHILE LENGTH(S)<=M
%RESULT=S
%END                                            ; ! of function 'ITOSTR'
!*
!*
!* MAIN PROGRAM NOW
!*
ASTK=ASTK.ASTK%AND BLANK="                                   " %C
   %IF BLANK=""
DATETIME=" ".DATE." ".TIME." *"
M=0
PRINTSTRING("CROSSREF VERSION ".VERSION."
")
PRINTSTRING("PARAMS ? : NO OUTPUT FILE
")%ANDRETURNUNLESS INPUT->INPUT.("/").OUTPUT%AND0<LENGTH(OUTPUT)<=NAMLEN
M=1%IF INPUT->INPUT.(",").NAML     ; ! IGNORE ACTUAL TEXT
NAML=INPUT
VNAME=""%UNLESS NAML->VNAME.(".").NAML
MEMNAME=""%UNLESS NAML->NAML.("_").MEMNAME
PRINTSTRING("INVALID PARAMETERS : ".INPUT."
") %ANDRETURNUNLESS0<LENGTH(NAML)<=NAMLEN%AND %C
   0<=LENGTH(MEMNAME)<=NAMLEN%AND(LENGTH(VNAME)=JOBNAMLEN%OR VNAME="")
NAML=VNAME.".".NAML%UNLESS VNAME=""
DEFINE("2,".INPUT)
DATASTART=SMADDR(2,DEND)
MAXNAMES=(INT(DEND/PAGESIZE)+5)*20
%IF M=1%THENSTART
PRINTSTRING("You have requested more than".ITOSTR(MAXNAMES,1). %C
   " name table entries
     (calculated from the size of ".INPUT.")
")
PROMPT("EXTRA=")
READ(M)
MAXNAMES=MAXNAMES+20     ; ! AN EXTRA PAGE WORTH ANY WAY
MAXNAMES=MAXNAMES+M-20%IF M>20
%FINISH
MAXUSES=6*MAXNAMES
MAXSTRINGS=8*MAXNAMES
PRINTSTRING("Maxima:- Names =".ITOSTR(MAXNAMES,1)."   Use of names =".%C
   ITOSTR(MAXUSES,1)."   Name string space =".ITOSTR(MAXSTRINGS,1)."
")
DEFINE("1,".OUTPUT)
SELECTOUTPUT(1)
LENIN=LENGTH(INPUT)
LENGTH(BLANK)=LENGTH(HEADER)-LENIN//2
LENGTH(ASTK)=LENGTH(HEADER)+LENGTH(DATETIME)+LENIN
NEWLINES(10)
PRINTSTRING(BLANK.ASTK."
"  .BLANK.HEADER.INPUT.DATETIME."
")
PRINTSTRING(BLANK.ASTK."





"  .BLANK. %C
   "Meanings of characters appended to names and line numbers:-

")
PRINTSTRING(BLANK."*   indicates a routine, function or map
"  .BLANK."!   indicates a record or recordarray format name
")
PRINTSTRING(BLANK. %C
   "A   means the variable is assigned a new value on this line
"  .BLANK."M   indicates multiple use of the variable on this line
")
PRINTSTRING(BLANK. %C
 "G   indicates the variable is global to the textual level at this line
")
!*
!* END OF INITIALISATION
!*
%BEGIN
%CONSTINTEGER MAXNLN=64,MAXVNAME=19,NCONDS=4,NDECLARS=17,NEXTS, %C
   NIGNORES=2,NPROCS,NSYMS=3,NUMLEN=4
%CONSTBYTEINTEGERARRAY SYMBOL(0:218)=0(48),8(10),0(7),7(26),0(4),7,0,
   7(26),0(70),3,2,6,3,1,0(2),3(2),0(2),3,0,3(2),0(2),3(2),5,0(6)
%CONSTBYTEINTEGERARRAY TYPE(0:127)=0(10),1,0(21),4,3,2,0,0,5,0,2,0(19),
   6,0(5),8(26),0(37)
%CONSTSTRING(1)%ARRAY NSYM(0:2)="A","M","G"
%OWNSTRING(27)GLOBMESS="    Global variables used ="
%OWNSTRING(255)ST
%OWNSTRING(6)%ARRAY CONDITION(1:4)="IF","UNLESS","UNTIL","WHILE"
%OWNSTRING(6)%ARRAY IGNORE(1:2)="FORMAT","SPEC"
%OWNSTRING(7)%ARRAY PROC(1:3)="ROUTINE","FN","MAP"
%OWNSTRING(7)%ARRAY DECLAR(1:17)="INTEGER","REAL","STRING","RECORD",
   "NAME","ROUTINE","ARRAY","BYTE","SHORT","HALF","LONG","OWN","CONST",
   "DYNAMIC","SYSTEM","SPEC","SWITCH"
%OWNSTRING(9)%ARRAY EXT(1:2)="EXTERNAL","EXTRINSIC"
%INTEGER AD,ASL,COLON,COMMA,COND,DDECL,DECL,DISP,DPTR,FORMATON,GASL, %C
   GLOBALUSE,GLOBS,GLMESSLEN,GLPERLINE,HASH,I,J,K,KEY,LASL,LAST,LEN, %C
   LENG,LK,LOCAL,LPOS,NAMAD,NASL,NEW,NUMBER,NUMPERLINE,NUMSTART,POS, %C
   PTRI,ROUT,ROUTON,S,SASL,START,STRNG,SYM,T,V
%STRING(19)GNAME
%STRING(63)KEYWORD,SS
%BYTEINTEGERARRAY ASTRING(0:MAXSTRINGS),LINE(-1:MAXLINE)
%INTEGERARRAY GLOBAL(0:MAXGLOB),HASHTAB(0:MAXHASH),PTR(1:MAXNAMES)
%BYTEINTEGERNAME LIST
%STRINGNAME NAMEST
%BYTEINTEGERARRAYNAME DATA
%BYTEINTEGERARRAYFORMAT F(1:DEND)
%RECORDFORMAT DSP(%INTEGER ADDR,LINE,SASL,GASL,LDEC)
%RECORDFORMAT NM(%STRINGNAME NAMEST,%BYTEINTEGER ROUT,DISP, %C
   %INTEGER HASH,LAST,LPTR)
%RECORDFORMAT LNO(%INTEGER LNUM,PTR,%BYTEINTEGER NUM)
%RECORDARRAY DISPLAY(0:MAXDISP)(DSP)
%RECORDARRAY NAME(1:MAXNAMES)(NM)
%RECORDARRAY LINENUM(1:MAXUSES)(LNO)
%RECORDNAME DISPL(DSP)
%RECORDNAME NAM(NM)
%RECORDNAME LN(LNO)
%SWITCH SYMB(0:7),SW(0:6)
!*
%ROUTINE CLOSE(%STRING(255)S)
%EXTERNALROUTINESPEC CLOSESM(%INTEGER N)
%EXTERNALROUTINESPEC CLEAR(%STRING(63)S)
PRINTSTRING(ST)
NEWPAGE
SELECTOUTPUT(0)
CLOSESTREAM(1)
PRINTSTRING(S."
")
CLOSESM(2)
CLEAR("1,2")
%END                                           ; ! of routine 'CLOSE'
!*
%ROUTINE OVERFLOW(%STRING(63)ST,%INTEGER MAX)
CLOSE(ST." on line".ITOSTR(NUMBER,1)." (max =".ITOSTR(MAX,1).")")
%MONITOR
%STOP
%END                                           ; ! of routine 'OVERFLOW'
!*
%ROUTINE GETKEYWORD
KEYWORD=""
I=POS
KEYWORD=KEYWORD.TOSTRING(LINE(I)!!128)%AND I=I+1%WHILE LINE(I)>128
LK=LENGTH(KEYWORD)
%END                                         ; ! of routine 'GETKEYWORD'
!*
%STRINGFN KEYEND(%STRINGARRAYNAME KEY,%INTEGER N)
%CYCLE I=1,1,N
%RESULT="YES"%IF KEYWORD->KEYWORD.(KEY(I)).SS%AND SS=""
%REPEAT
%RESULT="NO"
%END                                            ; ! of function 'KEYEND'
!*
%ROUTINE NPL(%INTEGER T,I)
%OWNINTEGER NLN                        ; ! NEWPAGE FIRST
PRINTSTRING(ST)
ST=""
%IF T>=NLN%THEN NEWPAGE%AND NLN=MAXNLN%ELSE NEWLINES(I)%AND NLN=NLN-I
%END                                           ; ! of routine 'NPL'
!*
%ROUTINE SORTPTRS(%INTEGER A,B)
%INTEGER I,J,K,L,N,PTRJ,PTRK
N=1
L=B-A+1
N=2*N%WHILE N<L
L=A-1
%WHILE N>1%CYCLE
N=N//2
I=L
%CYCLE
I=I+1
J=I+N
%EXITIF J>B
K=I
%UNTIL K<A%CYCLE
PTRJ=PTR(J)
PTRK=PTR(K)
%EXITIF NAME(PTRJ)_NAMEST>=NAME(PTRK)_NAMEST
PTR(J)=PTRK
PTR(K)=PTRJ
J=K
K=K-N
%REPEAT
%REPEAT
%REPEAT
%END                                           ; ! of routine 'SORTPTRS'
!*
%ROUTINE NEWAD
V=(V+97)&MAXHASH              ; ! 97 IS A LARGE PRIME NUMBER TO GET BIG 
                                ! GAP AND TOTAL COVERAGE OF HASH TABLE
AD=HASHTAB(V)
%END                                           ; ! of routine 'NEWAD'
!*
%STRINGFN SPACES(%INTEGER N)
%OWNSTRING(63)S= %C
   "                                                               "
LENGTH(S)=N
%RESULT=S
%END                                           ; ! of function 'SPACES'
!*
%STRINGFN KEYSTART(%STRINGARRAYNAME KEY,%INTEGER N)
%CYCLE I=1,1,N
%RESULT="YES"%IF KEYWORD->(KEY(I)).SS
%REPEAT
%RESULT="NO"
%END                                          ; ! of function 'KEYSTART'
!*
%ROUTINE INCRDISP                      ; ! INCREMENTING DISPLAY LEVEL
DISP=DISP+1
OVERFLOW("Display level overflow",MAXDISP)%IF DISP>MAXDISP
DISPL==DISPLAY(DISP)
DISPL_LDEC=ASL
DISPL_LINE=NUMBER
DISPL_ADDR=0
DISPL_SASL=SASL
DISPL_GASL=GASL
%END                                   ; ! of routine 'INCRDISP'
!*
DATA==ARRAY(DATASTART,F)
NUMSTART=1+MAXVNAME+NUMLEN
NUMPERLINE=(OUTLINE-MAXVNAME-1)//(1+NUMLEN+NSYMS)
GLMESSLEN=LENGTH(GLOBMESS)+1
GLPERLINE=(OUTLINE-GLMESSLEN)//(MAXVNAME+1)
%CYCLE I=1,1,MAXNAMES
NAM==NAME(I)
NAM=0
NAM_LAST=I+1
%REPEAT
%CYCLE I=1,1,MAXUSES
LN==LINENUM(I)
LN=0
LN_PTR=I+1
%REPEAT
%CYCLE I=0,1,MAXHASH
HASHTAB(I)=-1
%REPEAT
ASL=1
COLON=1
DPTR=1
LASL=1
NASL=1
SASL=1
DISP=0
GASL=0
NUMBER=0
STRNG=0
ASTRING(0)=0
DISPL==DISPLAY(0)
DISPL=0
DISPL_LINE=1
DISPL_LDEC=ASL
!*
!* START OF READING IN
!*
NEXTLINE:NUMBER=NUMBER+COLON
COLON=1
COMMA=3
LINE(-1)=0
LEN=0
LAST=0
SW(4):KEY=0                                  ; ! SPACE
NEXT:OVERFLOW("Input file complete",DEND)%IF DPTR>DEND
S=DATA(DPTR)&127                             ; ! NEXT CHARACTER
DPTR=DPTR+1
T=TYPE(S)
->SW(T&COMMA)%IF T=1%OR T=2
STR:KEY=0%IF T=0
->SW(T&7)%IF STRNG=0
->NEXT
SW(2):STRNG=S-STRNG%IF STRNG=0%OR STRNG=S       ; ! QUOTE, EITHER ' OR "
%IF STRNG=''''%AND LEN>0%THENSTART     ; ! FOR SPECIAL CONSTANTS
LEN=LEN-1%IF LAST='M'%OR LAST='X'%OR LAST='B'
%FINISH
KEY=0
SW(0):LAST=S+KEY                       ; ! ANY OTHER CHARACTER
%IF COMMA=3%THENSTART
LINE(LEN)=LAST
LEN=LEN+1
OVERFLOW("Input line too long",MAXLINE)%IF LEN>MAXLINE
%FINISH
->NEXT
SW(3):COMMA=1%IF LEN=0%OR LAST=':'           ; ! %COMMENT
T=0
->STR
SW(5):KEY=128                                ; ! PERCENT
->NEXT
SW(6):COLON=0                                ; ! SEMI-COLON
SW(1):%IF LAST='C'+128%THENSTART             ; ! NEWLINE
LEN=LEN-1
KEY=0
LAST=0
->NEXT
%FINISHELSE LINE(LEN)=0
!*
!* END OF READING IN
!*
LAST=0
ROUT=0
ROUTON=0
DDECL=0
DECL=0
FORMATON=0
POS=0
COND=0
LK=0
!*
!* START OF ANALYSIS
!*
SYMB(0):NEXTSYM:POS=POS+LK              ; ! ALL NON-SPECIAL CHARACTERS
->NEXTLINE%IF POS>=LEN
LK=1
SYM=LINE(POS)
T=SYMBOL(SYM)
%IF SYM>128%THENSTART
GETKEYWORD
COND=1%AND->NEXTSYM%IF KEYEND(CONDITION,NCONDS)="YES" 
        ! CONDITION STATEMENT
%FINISHELSE LAST=SYM
DECL=1%IF DDECL=1%AND SYM=','
->SYMB(T&7)
SYMB(6):->SYMB(3)%IF KEYWORD->("CONST").SS
LK=LEN-POS%IF KEYWORD="COMMENT"           ; ! %COMMENT
->NEXTSYM
SYMB(1):%IF KEYWORD="END"%OR KEYWORD="ENDOFPROGRAM"%OR %C
   KEYWORD="ENDOFFILE"%THENSTART
!*
!* START OF PRINT OUT
!*
START=DISPL_LDEC
I=DISPL_GASL
%IF GASL>I%THEN GLOBS=(GASL-I)//GLPERLINE+3%ELSE GLOBS=0
I=ASL-START+GLOBS+4
I=I+1%IF ASL=START
I=I+1%IF GLOBS>0
NPL(I,3)           ; ! CHECK HOW MANY LINES LEFT
I=DISPL_ADDR
%IF I=0%THEN ST=ST."BLOCK"%ELSE ST=ST."ROUTINE/FUNCTION/MAP ". %C
   NAME(I)_NAMEST
ST=ST." starting at line".ITOSTR(DISPL_LINE,1)." (textual level". %C
   ITOSTR(DISP,1).")"
NPL(0,1)
%IF ASL=START%THEN NPL(0,1)%AND ST=ST."    No local variables"%ELSESTART
ASL=ASL-1                                   ; ! STEP BACK TO LAST LOCAL
SORTPTRS(START,ASL)%IF START<ASL            ; ! IF ENOUGH
J=ASL
ASL=START
%CYCLE I=START,1,J                          ; ! THROUGH ALL THE LOCALS
PTRI=PTR(I)
NAM==NAME(PTRI)
%IF NAM_DISP=DISP%THENSTART         ; ! ACTUAL LOCAL NOT GLOBAL IMPLICIT
NPL(0,1)
NAMEST==NAM_NAMEST
ST=ST.TOSTRING(NAM_ROUT).NAMEST
SYM=NUMSTART-LENGTH(ST)
LENIN=0
LPOS=LINENUM(NAM_LPTR)_PTR                  ; ! FIRST LINE NUM RECORD
V=LPOS
%UNTIL LPOS=V%CYCLE
LN==LINENUM(LPOS)
NPL(-2,1)%AND LENIN=0%AND SYM=NUMSTART%IF LENIN=NUMPERLINE
         ! TAKE UP SLACK ON PAGE 
LENIN=LENIN+1
ST=ST.ITOSTR(LN_LNUM,SYM)
SYM=NUMLEN
%CYCLE K=0,1,NSYMS-1
%IF LN_NUM&(1<<K)>0%THEN ST=ST.NSYM(K)%ELSE SYM=SYM+1
%REPEAT
M=LN_PTR
LN_PTR=LASL                             ; ! RETURN TO ASL
LASL=LPOS
LPOS=M
%REPEAT
LPOS=NAM_LAST
NAM_LAST=NASL                           ; ! RETURN TO ASL
NASL=PTRI
V=NAM_HASH
AD=HASHTAB(V)
NEWAD%WHILE AD#PTRI                     ; ! REHASH
HASHTAB(V)=LPOS
%IF LPOS=-1%THENSTART                   ; ! FILL IN POSSIBLE HOLE
%CYCLE
NEWAD
%EXITIF AD=-1
HASH=NAME(AD)_HASH
LPOS=HASHTAB(HASH)
%WHILE LPOS#-1%AND HASH#V%CYCLE
HASH=(HASH+97)&MAXHASH
LPOS=HASHTAB(HASH)
%REPEAT
HASHTAB(HASH)=AD
HASHTAB(V)=LPOS
%REPEAT
%FINISH
%FINISHELSE PTR(ASL)=PTRI%AND ASL=ASL+1 ; ! RETURN TO LIST, AND PUT BACK
                                      ! IN AS THIS WAS A GLOBAL IMPLICIT
%REPEAT
SASL=DISPL_SASL%IF ASL=START
%FINISH                                 ; ! NO LOCAL VARIABLES
%IF GLOBS>0%THENSTART                   ; ! SOME GLOBALS
LENIN=0
NPL(0,2)
ST=ST.GLOBMESS
SYM=1
%CYCLE I=DISPL_GASL,1,GASL-1
NPL(-2,1)%AND LENIN=0%AND SYM=GLMESSLEN%IF LENIN=GLPERLINE
LENIN=LENIN+1
GNAME=NAME(GLOBAL(I))_NAMEST
ST=ST.SPACES(SYM).GNAME
SYM=MAXVNAME-LENGTH(GNAME)+1
%REPEAT
GASL=DISPL_GASL
%FINISH
!*
!* END OF PRINT OUT
!*
CLOSE("")%ANDSTOPIF DISP=0
LK=0%UNLESS KEYWORD="END"            ; ! 0 = RESET TO END FOR NEXT ROUND
DISP=DISP-1
DISPL==DISPLAY(DISP)
%FINISHELSESTART
->SYMB(3)%IF KEYSTART(EXT,NEXTS)="YES"
%FINISH
->NEXTSYM
SYMB(2):INCRDISP%AND->NEXTSYM%IF KEYWORD="BEGIN"      ; ! %BEGIN
SYMB(3):%IF T=1%OR T=6%OR KEYSTART(DECLAR,NDECLARS)="YES"%THENSTART
DDECL=1                                     ; ! DECLARATION OF VARIABLES
DECL=1
%IF ROUTON=0%THENSTART
%IF KEYEND(IGNORE,NIGNORES)="YES"%THENSTART
%IF IGNORE(I)="FORMAT"%THENSTART
%IF KEYWORD->("RECORD").SS%THENSTART
%IF SS=""%THEN FORMATON=1%ELSE FORMATON=-1
%FINISH
%FINISHELSE ROUT=2
%FINISH%ELSESTART
INCRDISP%AND ROUT=1%IF KEYEND(PROC,NPROCS)="YES"%AND KEYWORD#"SHORT"
%FINISH
ROUTON=ROUT
%FINISH
%FINISH
->NEXTSYM
SYMB(5):COND=0%IF KEYWORD->("THEN").SS         ; ! CONDITION COMPLETE
->NEXTSYM
!*
!* END OF KEYWORD ANALYSIS
!*
SYMB(7):LOCAL=0                           ; ! NAME FOUND
START=POS-1
LIST==LINE(START)
DECL=0%IF LIST='('%OR LIST=':'          ; ! KNOCK DOWN FLAG FOR SPECIALS
%IF FORMATON=2%AND DECL#0%THEN LAST='_'%AND V=LAST-'A'%AND LENG=1 %C
   %ELSE V=0%AND LENG=0
%WHILE T=7%OR T=8%CYCLE
POS=POS+1
I=SYM
SYM=LINE(POS)
T=SYMBOL(SYM)
%IF I='_'%THENSTART           ;  ! SUBNAMES ARE TREATED AS PART OF WHOLE
%EXITIF T#7                            ; ! AND MUST BE ALPHA
LOCAL=1%UNLESS LENG=0
%FINISH
LENG=LENG+1
V=V<<3+I-'A'
%REPEAT
NEW=0
LOCAL=1%IF SYM=':'%OR(LIST='<'%AND SYM='>')%OR %C
   (LIST='>'%AND LINE(START-1)='-'%AND LINE(START-2)#0%AND %C
   7#SYMBOL(LINE(START-2))#8)          ; ! LABEL, JUMP OR USERCODE LABEL
LENG=MAXVNAME%IF LENG>MAXVNAME
LIST=LENG                         ; ! ITOSTR IN LENGTH FOR USE BY STRING
VNAME=STRING(ADDR(LIST))           ; ! PICK UP DIRECTLY
VNAME="_".FROMSTRING(VNAME,1,LENGTH(VNAME)-1)%IF FORMATON=2
V=(V-LENG+LAST-'A')&MAXHASH        ; ! FINALISE HASH VALUE
HASH=V                             ; ! TAKE COPY FOR USE
AD=HASHTAB(V)                      ; ! FIRST ENTRY
%WHILE AD>=0%AND NAME(AD)_NAMEST#VNAME%CYCLE
NEWAD
OVERFLOW("Hash table overflow at ".VNAME,MAXNAMES)%IF HASH=V
%REPEAT
%IF AD=-1%THENSTART               ; ! UNUSED ENTRY - NEW, GET NAME ENTRY
M=SASL
SASL=LENG+1+SASL
OVERFLOW("Name string table overflow at ".VNAME,MAXSTRINGS)%IF %C
   SASL>MAXSTRINGS
NAMEST==STRING(ADDR(ASTRING(M)))       ; ! START ADDRESS OF NEW STRING
NAMEST=VNAME                           ; ! ENTER NEW NAME
NEW=1                                  ; ! SET FLAG
%FINISHELSESTART
NAM==NAME(AD)
M=NAM_DISP
%IF M#DISP%AND((ROUT=1%AND M#DISP-1)%OR(ROUT#1%AND DECL=1) %C
   %OR LOCAL=1)%THEN NAMEST==NAM_NAMEST%AND NEW=1%ELSE NAMAD=AD
    ! POSSIBLE NEW INCARNATION AT DIFFERENT LEVEL
%FINISH
GLOBALUSE=0
%IF NEW=1%THENSTART                       ; ! NEW NAME ENTRY TO ALLOCATE
OVERFLOW("Too many names at ".VNAME,MAXNAMES)%IF NASL>MAXNAMES
NAM==NAME(NASL)                        ; ! NEW ENTRY RECORD
HASHTAB(V)=NASL                        ; ! UPDATE HASH POINTER
NAMAD=NASL
PTR(ASL)=NASL                          ; ! UPDATE POINTER ARRAY
ASL=ASL+1                              ; ! NEXT ENTRY IN POINTER
NASL=NAM_LAST                          ; ! UNSTACK FREE ASL
NAM_LAST=AD                            ; ! COPY IN CHAIN FOR THIS NAME
NAM_NAMEST==NAMEST
NAM_HASH=HASH
NAM_ROUT='*'
%IF LOCAL=0=DECL%THEN I=0%ELSESTART
%IF ROUT=0%THENSTART
I=DISP
%IF IMOD(FORMATON)=1%THEN NAM_ROUT='!'%ELSE NAM_ROUT=' '
%FINISHELSE I=DISP+ROUT-2
! GETS CORRECT DISPLAY LEVEL VALUE
%FINISH
LPOS=LASL
NAM_DISP=I
%FINISHELSESTART
LN==LINENUM(NAM_LPTR)                  ; ! GET LAST USE RECORD
%IF LN_LNUM=NUMBER%THEN LN_NUM=LN_NUM!2%ELSESTART ; ! SET MULTIPLE FLAG
LPOS=LN_PTR                            ; ! SET LAST CHAIN RECORD
LN_PTR=LASL                            ; ! SET NEXT CHAIN RECORD
GLOBALUSE=4%IF0<=NAM_DISP<DISP%AND ROUT=0; ! NO ROUTINES OR PERM/EXTERNAL
NEW=1
%FINISH
%FINISH
DISPL_ADDR=NAMAD%AND DISPL_LDEC=ASL%AND DISPL_SASL=SASL%IF ROUT=1
         ! FILL IN DETAILS FOR START OF LAST LEVEL
%IF NEW=1%THENSTART                       ; ! NEW LINE ENTRY TO ALLOCATE
NAM_LPTR=LASL                    ; ! POINT TO CURRENT LINE NUMBER RECORD
OVERFLOW("Excessive useage of ".VNAME,MAXUSES)%IF LASL>MAXUSES
LN==LINENUM(LASL)
LASL=LN_PTR                            ; ! UNCHAIN ASL
LN=0
LN_LNUM=NUMBER
LN_PTR=LPOS                            ; ! FILL IN LAST CHAIN
%IF GLOBALUSE#0%THENSTART
LN_NUM=4                                  ; ! GLOBAL USE
J=DISPL_GASL
%IF GASL>=J%THENSTART
%CYCLE I=J,1,GASL
%IF I=GASL%THENSTART
OVERFLOW("Excessive global useage of ".VNAME,MAXGLOB)%IF GASL>MAXGLOB
GLOBAL(GASL)=NAMAD
GASL=GASL+1
%EXIT
%FINISH
%EXITIF GLOBAL(I)=NAMAD
%REPEAT
%FINISH
%FINISH
%FINISH
LN_NUM=LN_NUM!(1-COND)%IF(SYM='='%OR(SYM='<'%AND LINE(POS+1)='-'))
         ! SET ASSIGNMENT FLAG
%IF ROUT=2%AND KEYWORD#"RECORD"%THEN LK=LEN-POS%ELSE LK=0
         ! IGNORE SPEC NAMES 
FORMATON=2%IF FORMATON=1                ; ! MARK FORMAT PARAMETERS
ROUT=0
->NEXTSYM
!*
!*
%END                                          ; ! of inner block
%END                                     ; ! of routine 'CROSSREFERENCE'
%ENDOFFILE