LEX    'FLTYPELX'
       ID     #FD 
       MSG    0
       POLL   0
 * 
 * G.B.Fraser   87/01/31 21:20
 *
 * Syntax:
 * FLTYPE$(file specifier)
 * eg. FLTYPE$("FLTYPELX:TAPE")
 *
 *
RSTK<R EQU    #014A8
R<RSTK EQU    #014DD
FTYPDC EQU    #06902
BSERR  EQU    #0939A
D0=AVS EQU    #09B2C
FILXQ$ EQU    #09B95
FINDF  EQU    #09F77
REVPOP EQU    #0BD31
EXPR   EQU    #0F23C
POLL   EQU    #12337
STRHED EQU    #14C2E
AVE=D1 EQU    #18BB8
D1MSTK EQU    #1954E
POPMTH EQU    #1B3DB
 *
eFSPEC EQU    #3A
eDVCNF EQU    #40
 *
pFSPCx EQU    #05
pFINDF EQU    #17
 *
FUNCR0 EQU    #2F89B
 *
 *
       ENTRY  ftype
       CHAR   #F
 *
       KEY    'FLTYPE$'
       TOKEN  200
 *
       ENDTXT
 *
 *
efspc  LC(4)  eFSPEC
bserr  GOVLNG BSERR
ave=d1 GOVLNG AVE=D1
d1mstk GOVLNG D1MSTK
d0=avs GOVLNG D0=AVS
 *
 *
       NIBHEX 411
 *
ftype  CD0EX         
       RSTK=C        
       GOSBVL R<RSTK
       GOSUB  ave=d1
       GOSBVL FILXQ$ 
       GONC  ext00
 *
 * FIND HP71 FILE
       ?A=0   W
       GOYES  efspc
       GOSUB  ave=d1 
       GOSBVL FINDF
       GONC   fl71
       B=C    A
       LC(4)  eDVCNF
       ?C=B   B
       GOYES  bserr
       GOTO   null
 *
fl71   D1=D1+ 16     
       GOTO   fltype 
 *
 *
 * EXTERNAL FILE
ext00  P=     0      
       LCHEX  2020   
       R0=C          
       GOSBVL POLL
       CON(2) pFSPCx 
       GONC   ft085
       GOTO   bserr  
ft085  ?XM=0
       GOYES  ext01
       GOTO   efspc  
 *
ext01  C=R0          
       R1=C          
       R0=A          
       GOSUB  d1mstk 
       GOSBVL POPMTH 
       GOSUB  ave=d1 
       GOSBVL POLL
       CON(2) pFINDF 
       GONC   extfl  
       A=C    A      
       LCHEX  16
       ?C=A   B      
       GOYES  null
       C=A    A      
       GOTO   bserr  
 *
extfl  ?XM=0
       GOYES  xfound
       GOTO   efspc
 *
xfound D1=(5) FUNCR0
       C=R0
       DAT1=C W
       D1=D1+ 11
 *
 * GET FILE TYPE
 * (D1 points to file type nibs)
 *
fltype GOSUB  d0=avs
       C=0    W      
       DAT0=C W      
       D0=D0+ 2      
       GOSBVL FTYPDC 
       GOSUB  d1mstk 
       GOSUB  d0=avs 
       C=DAT0 W      
       ?C=0   B      
       GOYES  ft040  
ft030  ?C=0   B      
       GOYES  ft050  
       D1=D1- 2      
       DAT1=C B      
ft040  CSR    W      
       CSR    W      
       GOTO   ft030  
 *
null   GOSUB  d1mstk
 *
ft050  GOSBVL STRHED 
       GOSBVL RSTK<R 
       C=RSTK        
       CD0EX         
 *
 * TRIM SPACES
       GOSUB  R10
       GOSUB  R30
       GOSUB  R10
       GOC    R50
*
R10    GOSBVL REVPOP
       B=0    M
       B=A    A
       BSRB
       LCHEX  20
R20    B=B-1  A
       GOC    R40
       A=DAT1 B
       ?C#A   B
       RTNYES B
       D1=D1+ 2
       GONC   R20
R30    A=B    A
       A=A+1  A
       A=A+A  A
       ASL    W
       ASL    W
       A=A-1  P
       D1=D1- 16
       DAT1=A W
       RTN
R40    C=RSTK
R50    GOSUB  R30
 *
 * EXIT
       GOVLNG EXPR
 *
       END