Trailing-Edge
-
PDP-10 Archives
-
steco_19840320_1er_E35
-
10,5676/teco/source/tecsym.mac
There are 3 other files named tecsym.mac in the archive. Click here to see a list.
SUBTTL Introduction
; Copyright (c) 1980, 1981 Stevens Institute of Technology, Hoboken, New Jersey
; 07030.
; This software may be used and copied provided that this copyright notice
;is included, and provided that copies of all modifications are sent to:
;
; TECO Project
; Computer Center
; Stevens Institute of Technology
; Castle Point Station
; Hoboken, New Jersey 07030
;
;
; The information in this software is subject to change without notice
; and should not be construed as a commitment by Stevens Institute of
; Technology.
; Search needed universals
SEARCH TECUNV ; TECO universal file
; Generate the prologue
TECVER==200 ; Major version number
TECMIN==1 ; Minor version number
TECEDT==1126 ; Edit level
TECWHO==0 ; Last editor
PROLOGUE(SYM,<Symbol table management>) ; Generate the TITLE and other stuff
SUBTTL Table of Contents
;+
;.pag.lit
; Table of Contents for TECSYM - Symbol table management
;
;
; Section Page
; 1. Introduction . . . . . . . . . . . . . . . . . . . . . 1
; 2. Table of Contents. . . . . . . . . . . . . . . . . . . 2
; 3. Revision History . . . . . . . . . . . . . . . . . . . 3
; 4. S$INIT - Symbol table initialization . . . . . . . . . 4
; 5. S$CINI - Per command initialization. . . . . . . . . . 5
; 6. S$LABL - Reference a label (tag) . . . . . . . . . . . 6
; 7. S$QREG - Reference a Q-register. . . . . . . . . . . . 7
; 8. S$FNDS - Find a symbol table entry . . . . . . . . . . 8
; 9. S$CMPS - Compare too strings for equality. . . . . . . 9
; 10. S$HASH - Hash a symbol . . . . . . . . . . . . . . . . 10
; 11. S$ALCH - Allocate a hash table . . . . . . . . . . . . 11
; 12. Low segment. . . . . . . . . . . . . . . . . . . . . . 12
; 13. End of TECSYM. . . . . . . . . . . . . . . . . . . . . 13
;.end lit.pag
;-
SUBTTL Revision History
COMMENT |
1000 Start of this version
1002 By: Robert McQueen On: 16-July-1980
- Start some work on a -20 interface and making KAs work with TECONC
- Fix a core management problem/symbol table problem defining the first
symbol
Modules: TECUNV,TECSYM,TECONC
1060 By: Robert McQueen On: 8-December-1980
Random problems....(p1) ==> (P2) in S$DELE.
Modules: TECSYM
1077 By: Nick Bush On: 6-Febuary-1981
1) Add routine do delete all tags for a given text buffer, and have it
called anytime the buffer becomes editable, or is destroyed.
2) Reset CUREDT to point at TXTBUF anytime the q-register which it points
at becomes disassociated with it.
Modules: TECUNV,TECPRS,TECCMD,TECECM,TECSYM
1125 By: Robert McQueen On: 29-September-1981
- Make symbol table entries movable blocks.
- Use the new linked list processing.
- Initial work to make TECSYM run in non-zero section.
Modules: TECUNV,TECECM,TECSYM,TECMEM
Start of Version 200A(1126)
|
SUBTTL S$INIT - Symbol table initialization
$CODE ; Put in code section
;+
;.HL1 S$INIT
;This routine will do the module initialization. It is called on the program
;start up.
;.literal
;
; Usage:
; PUSHJ P,S$INIT
; (Return)
;.end literal
;-
S$INIT: STORE T1,SYMBEG,SYMEND,0 ; Clear our storage
POPJ P, ; Return
SUBTTL S$CINI - Per command initialization
;+
;.HL1 S$CINIT
;This routine is called to initialize the symbol table management before
;each command is processed. This routine will clean up the symbol table of
;any symbols that are defined.
;-
S$CINI: CFXN. T1,LNKNXT,+TAGLNK,0 ; Any tags to delete?
POPJ P, ; No, nothing to clean up
$SAVE <P1> ; Save P1
S$CI.0: LOAD. P1,LNKNXT,+TAGLNK ; Get the address of the first tag
JUMPE P1,.POPJ ; Return when done
XMOVEI T1,$SYTPT(P1) ; Get the address of the pointer
CFXE. T2,TPTADR,(T1),0 ; Is this zero?
PUSHJ P,M$RELB ; No, release the block
MOVE T1,P1 ; Copy the address
MOVX T2,$SYLNK ; Unlink it from here
PUSHJ P,M$ULNK ; Unlink this entry
MOVE T1,P1 ; Get the address again
MOVX T2,$SYNXT ; Remove it from the hash table
PUSHJ P,M$ULNK ; Unlink this too
JRST S$CI.0 ; Loop for all tags
SUBTTL S$QRGC - Collect empty Q-registers
;+
;.hl1 S$QRGC
; This routine will check all of the Q-register symbol table entries
;and delete any that contain numeric values of 0.
;-
S$QRGC: CFXN. T1,LNKNXT,+QRGLNK,0 ; Any Q-regs defined?
POPJ P, ; No, all done
$SAVE <P1> ; Save P1
LOAD. P1,LNKNXT,+QRGLNK ; Get the address of the first Q-reg STE
SQRG.0: LOAD. T1,SYMQRG,(P1) ; Get the QRG block address
LOAD. T2,QRGDTP,(T1) ; Get the data type
CAXN T2,$DTNUM ; Numeric value?
SKIPE $QRVAL(T1) ; No, is the value 0?
JRST SQRG.N ; We can't delete this Q-reg
XMOVEI T1,$QRQRN(T1) ; Point at the name
PUSHJ P,M$RELB ; Release the pointer
LOAD. T1,SYMQRG,(P1) ; Get the QRG address back
PUSHJ P,M$RBLK ; Return the Q-reg
MOVE T1,P1 ; Get the address of the STE
LOAD. P1,LNKNXT,+$SYLNK(P1) ; And get the link to the next
PUSHJ P,S$DELE ; Delete the STE
JRST .+2 ; Skip one
SQRG.N: LOAD. P1,LNKNXT,+$SYLNK(P1) ; Get the next STE
JUMPN P1,SQRG.0 ; Loop until all done
POPJ P, ; And return
SUBTTL S$TAGC - Clean up tag's on Q-register exit
;+
;.hl1 S$TAGC
; This routine will clean up any tags that were defined within a Q-register.
;It is called when the execution of the Q-register is finished.
;-
S$TAGC: CFXN. ,LNKNXT,+TAGLNK,0 ; Any tags at all?
POPJ P, ; No, all done
$SAVE <P1,P2> ; Save P1
MOVE P2,T1 ; Get the buffer to check
LOAD. P1,LNKNXT,+TAGLNK ; Get the address of the first tag STE
STGC.0: CFME. T1,TPTADR,+$SYTPT(P1),P2 ; Is this the buffer we want?
JRST STGC.N ; No, try the next
MOVE T1,P1 ; Get the address of the STE
LOAD. P1,LNKNXT,+$SYLNK(P1) ; And get the link to the next
PUSHJ P,S$DELE ; Delete the STE
JUMPN P1,STGC.0 ; Have another to check?
POPJ P, ; No, all done
STGC.N: LOAD. P1,LNKNXT,+$SYLNK(P1) ; Get the next STE
JUMPN P1,STGC.0 ; Loop until all done
POPJ P, ; And return
SUBTTL S$DELE - Delete a symbol table entry
;+
;.hl1 S$DELE
; This routine will delete a symbol table entry. Note that it assumes
;that all that needs to be returned is the block of memory itself.
;-
S$DELE: $SAVE <P1> ; Save some ac's
MOVE P1,T1 ; Get the STE address
XMOVEI T1,$SYTPT(P1) ; get the TPT address
SKIPE $TPADR(T1) ; Have an address?
PUSHJ P,M$RELB ; Release the TPT
MOVE T1,P1 ; Get the address
MOVX T2,$SYLNK ; Get the LNK offset
PUSHJ P,M$ULNK ; Unlink this block
MOVE T1,P1 ; Get the address
MOVX T2,$SYNXT ; Remove it from the symbol table
PUSHJ P,M$ULNK ; Unlink it and it goes away
POPJ P, ; Return to the caller
SUBTTL S$LABL - Reference a label (tag)
;+
;.hl1 S$LABL
; This routine will find or create the symbol table entry for a label.
;If the label is already defined it will give a non-skip returned,
;else it will give a skip return.
;.b.literal
; Usage:
; XMOVEI T1,Text.buffer.address
; MOVEI T2,Character.offset.for.start.of.symbol
; MOVEI T3,Number.of.characters
; PUSHJ P,S$LABL
; (Already defined, T1= symbol table entry address)
; (Not previously defined, T1= new symbol table entry address)
;
;.end literal
;-
S$LABL: MOVX T4,$SYLBL ; Get the symbol type
FALL S$SYMB ; And fall into general routine
S$SYMB: $SAVE <P1,P2,P3,P4> ; Save the Px ac's
DMOVE P1,T2 ; Get the args
MOVE P4,T4 ; Get the symbol type
STKTPT (T1,LABBUF) ; Stack the pointer
MOVE T1,P1 ; Get the index
IDIVI T1,5 ; And make the word/character index
HLL T1,BTAB-1(T2) ; . . .
MOVE P1,T1 ; Save the byte pointer without absolute address
LOAD. T2,TPTADR,+LABBUF ; Get the text buffer address
ADD T1,T2 ; Point to the buffer
ADDX T1,.BKTLN ; Now to the text
MOVE T2,P2 ; Get the number of characters
MOVE T3,P4 ; And get the label type
PUSHJ P,S$FNDS ; Look for the symbol
JRST S$LA.1 ; Didn't find it, create the STE
POPJ P, ; Return to the caller
S$LA.1: MOVE P3,T1 ; Save the hash address
MOVE T1,P2 ; Get the size of the symbol
IDIVI T1,5 ; And convert to number of words
JUMPE T2,.+2 ; Skip if multiple of 5
AOJ T1, ; Bump for the partial word
ADDX T1,$SYNAM ; Plus the amount for the rest of the entry
MOVX T2,.BTSYM ; Get the block type
PUSHJ P,M$ZBLK ; And get a block
SUBX T1,.BKLEN ; Back up for dumb memory manager
MOVX T2,$SYNXT ; Get the LNK offset
XMOVEI T3,-$SYNXT(P3) ; Get the pointer into the hash table
PUSHJ P,M$LINK ; Link the symbol in
MOVX T2,$SYLNK ; Get the LNK offset
XMOVEI T3,LNKTBL-$SYLNK ; Get the table address
MOVE T4,P4 ; Get a copy of this
IMULX T4,$LKLEN ; Mult by the length
ADD T3,T4 ; Compute the right offset
PUSHJ P,M$LINK ; Link this entry in
MOVE P3,T1 ; Get the STE address
LOAD. T1,TPTADR,+LABBUF ; Get the buffer address
XMOVEI T2,$SYTPT(P3) ; . . .
CAXN P4,$SYLBL ; Is this a tag (Label)
PUSHJ P,M$USEB ; . . .
ZERO. T1,SYMFLG,(P3) ; Clear the flags
STOR. P4,SYMTYP,(P3) ; Store the symbol type
STOR. P2,SYMCNT,(P3) ; And the length
LOAD. T1,TPTADR,+LABBUF ; Get the block address
ADD P1,T1 ; Point to the buffer
ADDX P1,.BKTLN ; Now to the text
MOVE T1,P1 ; Set up for M$MSTR
XMOVEI T2,$SYNAM(P3) ; Point to the name
TXO T2,<POINT 7> ; Build the byte pointer to it
MOVE T3,P2 ; Put the count in the right place
PUSHJ P,M$MSTR ; And stuff in the string
MOVE T1,P3 ; Get the address
JRST .POPJ1 ; And give the good return
SUBTTL S$QREG - Reference a Q-register
;+
;.hl1 S$QREG
; This routine will find or create the symbol table entry for a
;Q-register. If the Q-register is already defined it will give a non-skip
;return, else it will give a skip eturn.
;.literal
;
; Usage:
; XMOVEI T1,Text buffer address
; MOVEI T2,Character offset for the start of symbol
; MOVEI T3,Number of characters
; PUSHJ P,S$LABL
; (Already defined, T1 contains the symbol table entry addrss)
; (Not previously efined, T1 contains the new symbol table entry address)
;.end literal
;-
S$QREG: MOVX T4,$SYREG ; Get the symbol type
PJRST S$SYMB ; And go do the lookup
SUBTTL S$FNDS - Find a symbol table entry
;+
;.hl1 S$FNDS
; This routine will find a symbol table entry. If there is now entry for
;the string, it will return the hash table address where the new entry
;should go.
;.b.literal
; Usage:
; MOVE T1,Byte.pointer
; MOVEI T2,Character.count
; MOVEI T3,Symbol.type
; PUSHJ P,S$FNDS
; (Not found, T1= hash address)
; (Found, T1= STE address)
;
;.end literal
;-
S$FNDS: $SAVE <P1,P2,P3,P4> ; Save some room
DMOVE P1,T1 ; And move the args to a safer place
MOVE P3,T3 ; . . .
PUSHJ P,S$HASH ; Get the hash address for the symbol
MOVE P4,T1 ; Get the address for later
LOAD. T1,LNKNXT,(P4) ; Have something here?
JUMPE T1,S$FN.2 ; No, Give up
S$FN.0: CFME. T2,SYMTYP,(T1),P3 ; Correct symbol type?
JRST S$FN.1 ; No, go down the link
CAXE P3,$SYLBL ; Is this a label ?
JRST S$FN.3 ; No - Skip this
LOAD. T3,TPTADR,+LABBUF ; Get the buffer address
CFME. T2,TPTADR,+$SYTPT(T1),T3 ; Is this the correct text buffer address
JRST S$FN.1 ; No - Try the next
S$FN.3: CFME. T2,SYMCNT,(T1),P2 ; Correct length?
JRST S$FN.1 ; No, try the next
XMOVEI T2,$SYNAM(T1) ; Get the address of the name
TXO T2,<POINT 7> ; Build the byt inter
MOVE T3,P2 ; Get the length
MOVE T4,P1 ; Get the other byte pointer
PUSHJ P,S$CMPS ; And go compare the strings
JRST S$FN.1 ; Different, try the next
PJRST .POPJ1 ; Found it, return the address
S$FN.1: LOAD. T1,LNKNXT,+$SYNXT(T1) ; Get the address of the next symbol
JUMPN T1,S$FN.0 ; If we have one, return it
S$FN.2: MOVE T1,P4 ; Otherwise return the hash address
POPJ P, ; . . .
SUBTTL S$CMPS - Compare too strings for equality
;+
;.hl1 S$CMPS
; This routine will compare two non-word aligned strings and give a skip
;return if they are equal.
;It will use the EXTEND instruction if we are running on a KL-10.
;.b.literal
; Usage:
; MOVE T2,Byte.pointer.1
; MOVE T3,Byte.count
; MOVE T4,Byte.pointer.2
; PUSHJ P,S$CMPS
; (Not equal)
; (Equal)
;
;.end literal
;-
S$CMPS:
IFN FTKL,<
$SAVE <T1,P1,P2> ; Save the ac's we need
MOVE T1,T3 ; Get the count
MOVE T1+4,T4 ; Set the second byte pointer
MOVE T1+3,T1 ; And count
SETZB T1+2,T1+5 ; And clear the other AC's
EXTEND T1,[CMPSN ; Compare the string
EXP 0,0] ; With no fill characters
AOS (P) ; Equal
POPJ P, ; Not equal
> ; End of IFN FTKL
IFE FTKL,<
$SAVE <P1,P2> ; Save P1 and P2
S$CM.0: ILDB P1,T2 ; Get the one character
ILDB P2,T4 ; Get the other
CAIE P1,(P2) ; Same?
POPJ P, ; No, give up
SOJG T3,S$CM.0 ; Count the character and loop
PJRST .POPJ1 ; Give the good return
> ; End of IFE FTKL
SUBTTL S$HASH - Hash a symbol
;+
;.hl1 S$HASH
; This routine will return the hash address of a symbol.
;.b.literal
; Usage:
; MOVE T1,Byte.pointer.to.ascii.string
; MOVEI T2,Number.of.characters.in.string
; PUSHJ P,S$HASH
; (Hash address in T1)
;
;.end literal
;-
S$HASH: $SAVE <P1,P2> ; Save P1 and P2
DMOVE P1,T1 ; And put the args in a safer place
SKIPE HSHSIZ ; Have a hash table already ?
JRST S$HA.1 ; Yes, skip the allocation of one
LOAD. T2,TPTADR,+LABBUF ; Get the address of the buffer
SUB P1,T2 ; Make the address fixed (Could move if core does)
MOVE T1,HSHSIZ ; Get the hash table size again
PUSHJ P,S$ALCH ; Allocate the hash table
LOAD. T2,TPTADR,+LABBUF ; Get the address again
ADD P1,T2 ; Make the byte pointer absolute again
S$HA.1: SETZ T1, ; Clear a place to accumlate character sum
MOVE T2,P2 ; Get the length
S$HA.0: ILDB T3,P1 ; Get a character
ADD T1,T3 ; Total it in
SOJG T2,S$HA.0 ; And loop for all the chars
ADD T1,P2 ; Plus the length
IDIV T1,HSHSIZ ; And divide by the hash size
MOVE T1,T2 ; Get the address
IMULX T1,$LKLEN ; Multiply by the linked list overhead
ADD T1,HSHTBL ; Plus the address of the table
POPJ P, ; Return
SUBTTL S$ALCH - Allocate a hash table
;+
;.hl1 S$ALCH
; This routine will allocate a hash table of the next larger size.
;It will also re-hash any entries if we are increasing the size of the
;table.
;-
S$ALCH: JUMPE T1,S$AL.0 ; If nothing yet, go make a new one
STOPCD RHT,<Re-hashing symbol table not yet implemented>
S$AL.0: MOVX T1,D.HASH ; Get the hash size
MOVEM T1,HSHSIZ ; Save it for the hash routine
IMULX T1,$LKLEN ; Compute the real size
MOVX T2,.BTGEN ; Get the block type
PUSHJ P,M$ZBLK ; Get the block
MOVEM T1,HSHTBL ; Save the address
POPJ P, ; And return
SUBTTL Low segment
$IMPURE ; To the impure section
LOWVER(SYM,2) ; Low segment version number of this module
SYMBEG:! ; Start of low segment
LABBUF: BLOCK 1 ; Temp pointer in case of memory movement
HSHTBL: BLOCK 1 ; Address of hash table
HSHSIZ: BLOCK 1 ; Size of current hash table
LNKTBL: BLOCK <$SYMAX+1>*$LKLEN ; Link addresses to first symbol of each type
TAGLNK==LNKTBL+<$SYLBL*$LKLEN> ; Address of entry for tags
QRGLNK==LNKTBL+<$SYREG*$LKLEN> ; Address of entry for Q-registers
SYMEND==.-1 ; End of locations to be cleared on startup
SUBTTL End of TECSYM
END ; End of TECSYM