LEX    'LEXLEX' * Getting the ID, and high & low tokens of a LEX file
        ID     #EC      * J.Elhay, 12/1/88
        MSG    0
        POLL   0
        ENTRY  HIT      * high token entry
        CHAR   #F       * a function
        ENTRY  ID       * ID entry
        CHAR   #F
        ENTRY  LOT      * low token entry
        CHAR   #F
        KEY    'HITOKEN'* Syntax: HITOKEN(<filename>)
        TOKEN  58
        KEY    'ID'     * Syntax: ID(<filename>)
        TOKEN  59
        KEY    'LOTOKEN'* Syntax: LOTOKEN(<filename>)
        TOKEN  60
        ENDTXT
BSERR   EQU    #0939A   * BASIC system error driver
MFERR   EQU    #09393   * mainframe BASIC error driver
INVFSP  EQU    #066FC   * invalid file specifier error exit
FILXQ$  EQU    #09B95   * filname execute
FINDF+  EQU    #09F63   * find a file
HDFLT   EQU    #1B31B   * HEX to floating point conversion
FNRTN1  EQU    #0F216   * function return
F-R0-0  EQU    #2F89B   * function scratch
mFERR   GOVLNG MFERR
iNVFSP  GOVLNG INVFSP
FIND    CD0EX           * subroutine to set D1 at start of LEX file
        D0=(5) F-R0-0   * save D0
        DAT0=C A
        GOSBVL FILXQ$   * filename execute
        GONC   iNVFSP   * was the string popped a valid filename?
        ?A=0   W        * was the name omitted? (eg ":PORT")
        GOYES  iNVFSP   * no good
        CD1EX           * now we save D1
        D1=C            * without changing it
        D0=(5) (F-R0-0)+5 * store D1 in scratch RAM next to D0
        DAT0=C          * write it
        GOSBVL FINDF+   *ok- so now find it, ie set D1 to start of file
        GOC    mFERR    * carry set= file or device not found, ERRN in C(3,0)
        A=0    A        * zero C & A for filetype test
        C=0    A
        D1=D1+ 16       * nibs 16-20 should lie in range E208 to E20B
        A=DAT1 4        * read filetype nibs
        LC(4)  #E208    * smallest value
        ?A<C   A        * is ours less?
        GOYES  TYPE?    * then not LEX
        LC(1)  #B       * change the 8 to a B, giving largest value
        ?A>C   A        * is ours greater?
        GOYES  TYPE?    * then not LEX
        D1=D1- 16       * restore D1 to start of file
        RTN             * and return
TYPE?   C=0    W        * invalid file type error exit
        LC(2)  #3F      * error number is 63
        GOVLNG BSERR    * exit in disgrace!
        NIBHEX 411      * a single string parameter
HIT     GOSUB  FIND     * D1 set to start of valid file
        C=0    A
        LC(2)  #29      * offset to high token byte
        GONC   FINISH   *BET* carry cleared by D1=D1- 16
        NIBHEX 411      * one string only
ID      GOSUB  FIND     * as above
        C=0    A
        LC(2)  #25      * offset for ID byte
        GONC   FINISH   *BET*
        NIBHEX 411      * again one string only
LOT     GOSUB  FIND     * as above
        C=0    A
        LC(2)  #27      * offset to low token byte
FINISH  AD1EX           * swap D1 into A(A)
        A=A+C  A        * add the apprpriate offset
        AD1EX           * and swap back: D1 now at desired byte
        A=0    A        * clear A(A) - 1 less nib than clearing A(B)
        A=DAT1 B        * read desired byte
        GOSBVL HDFLT    * convert to floating point
        D0=(5) (F-R0-0)5 * restore D1
        C=DAT0 A        * from scratch
        D1=C            * reset D1 here
        D0=D0-5         * move 5 nibs back to collect D0
        C=DAT0 A        * pick it up
        D0=C            * and reset it
        C=A    W        * copy result to C(W)
        GOVLNG FNRTN1   * exit with answer.