program ISMPAR,1.0(101)			! retrieve ISAM parameters
!------------------------------------------------------------------------
!ISMPAR - Retrieve ISAM paramaeters from a file.  Similar to ISMROK but
!	  takes a file name rather than a file channel
!
!XCALL ISMPAR,IFNAME,ISMPAK
!
!MAP1 ISMPAK
!	MAP2 I'DEV,S,4			! device name (ASCII)
!	MAP2 I'UNIT,B,2			! unit #
!	MAP2 I'UPDCNT,B,4		! update counter
!	MAP2 I'RECSIZ,B,2		! rec size
!	MAP2 I'KEYSIZ,B,2		! key size
!	MAP2 I'KEYPOS,B,2		! key position
!	MAP2 I'IDAFRE,B,4		! IDA free pointer
!	MAP2 I'IDAFRC,B,4		! IDA freecount
!	MAP2 I'IDXFRE,B,4		! IDX free pointer
!	MAP2 I'IDXFRC,B,4		! IDX freecount
!	MAP2 I'RECALC,B,4		! records allocated *
!	MAP2 I'TOPDIR,B,4		! top directory block
!   MAP2 I'LEVELS,B,2               ! [101] # IDX levels
!   MAP2 I'BLKSIZ,B,2               ! [101] IDX blk size
!   MAP2 I'IDXTYP,B,2               ! [101] IDX type flags
!
!
! * If file not found, I'RECALC will be set to -1.
!
!	IF THE ISAM "ROCK" CONTAINS NO DRIVE OR UNIT NO,THE ROUTINE
!	WILL RETURN THE DEFAULT DEVICE & UNIT.
!
!--------------------------------------------------------------------
!EDIT HISTORY
![100] September 26, 2003 04:15 PM         Edited by Jack
!	Created
![101] August 17, 2008 06:30 AM         Edited by joaquin
!       Updated for ISAM 1.1 (add 3 new fields: LEVELS, BLKSIZ, TYPE)
!       Minor modernization (use symbols, etc.); Fix glitch in turning
!       LOKSER off (was turning it on)
!--------------------------------------------------------------------
++PRAGMA SBX
++PRAGMA ERROR_IF_NOT_MAPPED "ON"

++include ashinc:xcall.bsi
++include ashinc:ismdef.bsi
++include ashinc:ashell.def             ! [101]

map1 IFNAME,S,128			! File name (no extension) [101] was 32
					! (must have a trailing null)
map1 ISMPAK
    map2 I'DEV,S,4			! device name (ASCII)
    map2 I'UNIT,B,2			! unit #
    map2 I'UPDCNT,B,4		! update counter
    map2 I'RECSIZ,B,2		! rec size
    map2 I'KEYSIZ,B,2		! key size
    map2 I'KEYPOS,B,2		! key position
    map2 I'IDAFRE,B,4		! IDA free pointer
    map2 I'IDAFRC,B,4		! IDA freecount
    map2 I'IDXFRE,B,4		! IDX free pointer
    map2 I'IDXFRC,B,4		! IDX freecount
    map2 I'RECALC,B,4		! records allocated *
    map2 I'TOPDIR,B,4		! top directory block
    map2 I'LEVELS,B,2       ! [101] # IDX levels
    map2 I'BLKSIZ,B,2       ! [101] IDX blk size
    map2 I'IDXTYP,B,2       ! [101] IDX type flags

map1 I'ERR,B,4,-1
map1 LOKFLAG,F
map1 X,F
map1 EXISTS,F
map1 CH,F,6,47777			! starting file channel to try
map1 BYTES'READ,B,2
map1 FSPEC,S,32

! FSPEC MIAMEX function

map1 DDB
    map2 DEV,s,6		! 6 characters AMOS device
    map2 FILNAM,s,32		! 6 characters AMOS or 32 host
    map2 EXT,s,8		! 3 characters AMOS or 8 host
    map2 PRJ,s,3		! 3 character justified P
    map2 PRG,s,3		! 3 character justified PN
map1 FS'DRV,f,6,1
map1 FS'FMA,f,6,2
map1 FS'TOH,f,6,4
map1 STATUS,F


BEGIN:
	on error goto TRAP

	if XCBCNT < 2 then
	    print "Too few args in ISMPAR.SBX"
	    xcall MIAMEX,MX'EXITSBX
	endif

![101]	xcall MIAMEX,MX'XCBDATA,XCBADR,XCBGET,1,IFNAME
        xgetarg 1,IFNAME                                ! [101]

	! The trick here is that we need to open up the IDX to read
	! the rock.  The AMOS version did this using raw block I/O,
	! but this is not practical under Windows or UNIX.  To avoid
	! locking conflicts, we'll temporarily turn off LOKSER (if on).

	xcall MIAMEX,MX_GETLOKSER,LOKFLAG	! 0=off, else on [101] was 50
	if LOKFLAG then
                xcall MIAMEX,MX_SETLOKSER,0	! turn it off [101] was 51,1
	endif

	! now locate the file
	X = instr(2,IFNAME,"[")
	if X > 0 then
	    IFNAME = IFNAME[1,X-1] + ".IDX" + IFNAME[X,-1]
	else
	    IFNAME = IFNAME + ".IDX"
	endif
	lookup IFNAME,EXISTS
	if abs(EXISTS)<1 then		! try IDY
	    X = instr(1,IFNAME,".IDX")
	    IFNAME[X+3;1]="Y"
	    lookup IFNAME,EXISTS
	endif

	if abs(EXISTS)<1 then
	    I'RECALC = I'ERR
	    goto EXIT'XCALL
	endif


	! find an open file channel and open file
	do while erf(CH)>=0 	! (open files return 0 or 1)
	    CH = CH + 1
	loop

	open #CH, IFNAME, input
	xcall GET, ISAM'HEADER, CH, 512, BYTES'READ
	close #CH

        if BYTES'READ < len(ISAM'HEADER) then ! [101]
            ? "Error in ISMPAR.SBX: IFNAME=";IFNAME;" BYTES'READ=";BYTES'READ
            sleep 5
            end
        endif

        ! note: ISAM'HEADER defined in ISMDEF.BSI

	call SWAP'HEADER'BYTES		! from ISMDEF.BSI

	if DATA'DEVICE # "" then
	    I'DEV = DATA'DEVICE[1,3]
	    I'UNIT = DATA'DEVDRV
	else
	    xcall MIAMEX,MX_FSPEC,IFNAME,"","",FS_DRV+FS_FMA,DDB,STATUS ![101]
	    I'DEV  = DEV[1,3]
	    I'UNIT = val(DEV[4,-1])
	endif
    I'UPDCNT = UPDATE'COUNTER
    I'RECSIZ = RECORD'SIZE
    I'KEYSIZ = KEY'SIZE
    I'KEYPOS = KEY'POSITION
    I'IDAFRE = IDA'FREELIST
    I'IDAFRC = IDA'FREECOUNT
    I'IDXFRE = IDX'FREELIST
    I'IDXFRC = IDX'FREECOUNT
    I'RECALC = RECORDS'USED
    I'TOPDIR = TOP'DIR'BLOCK
    I'LEVELS = IDX'DIR'LEVELS       ! [101]
    I'BLKSIZ = DIR'BLOCK'SIZE       ! [101]
    I'IDXTYP = INDEX'TYPE           ! [101]

EXIT'XCALL:
	! restore LOKSER to how it was
	if LOKFLAG then xcall MIAMEX,MX_SETLOKSER,LOKFLAG   ! [101] was 51

	! update the RTNCODE parameter
![101	xcall MIAMEX,MX'XCBDATA,XCBADR,XCBPUT,2,ISMPAK
        xputarg 2,ISMPAK        ! [101]
	end			! back to Basic


!------------------------------------------------------------------------

TRAP:
	? "Error";err(0);"at ";err(1);" in ISMPAR.SBX; last file: ";err(2);
	if err(0)>=13 and err(0)<=26 then
	    xcall FILNAM,ERR(2),FSPEC
	    ? "(";FSPEC;")"
	else
	    ?
	endif
	stop
	end		! return to caller