!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!
!!	ISMDMP.BAS			System management
!!
!!	Computer Resources, Inc.	
!!	101 39th Street North
!!	Birmingham, Alabama, 35222	
!!	(205) 591-8810					
!!	                      		
!!	ver. 1:	AUGUST,1986		
!!					
!!	Author:	Frederick l. McMaster	FLM(BB)
!!
!!	Thanks DAVE/US for the numeric conversion routines.
!!
!! 1.	There is still some problems in the routine that reads in the 
!!	associated data record.
!!
!! 2.   I am only using the second set of binary bytes for the record
!!	pointers.
!!
!!	If you figure out these problems let me know.	tnx
!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

map1 idx'ctl
        map2 dev,               b,2
        map2 unt'no,            b,2
        map2 idx1,              b,2
        map2 update1,           b,2
        map2 update2,           b,2
        map2 idx'rec'siz,       b,2
        map2 idx'key'siz,       b,1
        map2 idx'dir'siz,       b,1
        map2 idx'dir'ent,       b,1
        map2 idx'key'type,      b,1
        map2 idx'key'pos,       b,2
        map2 ida'blk'fac,       b,2
        map2 idx'ida'fre'ptr,   b,2
        map2 idx'ida'fre'ptr'2, b,2
        map2 idx'ida'fre'cnt,   b,2
        map2 idx'ida'fre'cnt'2, b,2
        map2 idx'fre'lst'ptr,   b,2
        map2 idx'fre'lst'ptr'2, b,2
        map2 idx'fre'cnt,       b,2
        map2 idx'fre'cnt'2,     b,2
        map2 idx'rec'allocated, b,2
        map2 idx'rec'alloc'2,   b,2

        map2 idx'filler'1
                map3 idx'fill'1,b,2
                map3 idx'fill'2,b,2
                map3 idx'fill'3,b,2
                map3 idx'fill'4,b,2

        map2 top'dir'block,     b,2
        map2 top'dir'block'2,   b,2

        map2 idx'filler'2
                map3 idx'fill'5,b,2
                map3 idx'fill'6,b,2
                map3 idx'fill'7,b,2
                map3 idx'fill'8,b,2

        map2 dir'blk'siz,       b,2
        map2 idx'filler'3,      x,450

map1 idx'par:
        map2 idx'rcl,f,,        512
        map2 idx'ptr,f
        map2 idx'max,f

map1 work'file
        map2 wk'ptr,f
        map2 work'rec'siz,f
        map2 work'key'siz,f
        map2 work'dir'siz,f
        map2 work'dir'ent,f

map1 work'record,x,512

map1 file'name,s,50

map1 data'file'stuff
        map2 data'file,s,50
        map2 data'record,x,512
        map2 found'data,f
        map2 block'ptr,f
        map2 prt'data'record,s,512
        map2 data'rec'ptr,f
        map2 data'file'open,f


map1 ptr,f
map1 x,f
map1 y,f
map1 i,f
map1 j,f
map1 found,f

map1 oct1,f
map1 oct2,f

map1 data'ptr,f
map1 cvt,s,4,"0000"

map1 decimal,f
map1 tmp'val,f

map1 same,s,13,"Same as Index"
map1 op,s,10

map1 valid'rad50,s,40,  "#ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789"
map1 valid'hex,s,16,    "0123456789ABCDEF"
map1 valid'octal,s,8,   "01234567"

map1 hex'val,s,4,       space(4)
map1 oct'val,s,6,       space(6)
map1 bin'val,s,16,      space(16)
map1 rad50,s,3,         space(3)

map1 valid'key,s,37,    " 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"

map1 wrk'key,x,512
map1 dsp'key,x,512
map1 dsp'cnt,f

map1 dsp'ptr
        map2 dsp'ptr'1,b,2
        map2 dsp'ptr'2,b,2      

map1 chn'ptr
        map2 chn'ptr'1,b,2
        map2 chn'ptr'2,b,2

map1 command,s,1
map1 dashes,s,512

map1 ddate,s,8
map1 ttime,s,8


   for x = 1 to 8
        dashes = dashes +&
        "----------------------------------------------------------------"
   next x


!--------------------------
!
!  End of Map Definitions
!
!--------------------------

start:

        ?tab(-1,0);"Basic ISMDMP utility "

st1:    ?:input line "Enter file name ";file'name

        xcall strip,file'name
        if file'name = "" end

        y = instr(1,file'name,".")
 
        if y = 0 then file'name = file'name +".idx"

        lookup file'name,found
        if found = 0 goto file'not'found

        open #1,file'name,random,512,ptr
 
        read #1,idx'ctl

        call rad50

        call dsp

        call utility'menu
close:
        close #1

        goto start      

!---------------------------
!
!Numeric Conversion Routines
!
!---------------------------

cvt'dec:
        oct1 = decimal
        call out'octal
        call out'hex
        return


in'hex:
        j = 0
        for i = len(op) to 1 step -1
        j = j + 1
        decimal = decimal +((instr(1,valid'hex,(mid$(op,j,1)))-1)*(16**(i-1)))
        next i
        return

out'hex:
        hex'val = ""
        for i = 4 to 1 step -1
        tmp'val = int(decimal / 16**(i-1))
        decimal = decimal - tmp'val*16**(i-1)
        hex'val = hex'val + mid$(valid'hex,(tmp'val+1),1)
        next i
        return

in'binary:
        decimal = 0 : j = 0
        for i = len(op) to 1 step -1
        j = j + 1
        if mid$(op,j,1) = "1" then decimal = decimal + 2**(i-1)
        next i
        return

out'bin:
        bin'val = "" :
        for i = 16 to 1 step -1
        tmp'val = int(decimal / 2**(i-1))
        decimal = decimal - tmp'val*2**(i-1)
        if tmp'val = 1 then bin'val = bin'val + "1" &
        else bin'val = bin'val + "0"
        next i
        return

in'oct:
        j = 0
        for i = len(op) to 1 step -1
        j = j + 1
        decimal = decimal + val(mid$(op,j,1))*(8**(i-1))
        next i
        return


out'octal:
        oct'val = ""
        for i = 6 to 1 step - 1
        tmp'val = int(oct1 / 8**(i-1))
        oct1 = oct1 - tmp'val*8**(i-1)
        oct'val = oct'val +mid$(valid'octal,(tmp'val+1),1)
        next i 
        return

rad50:
        rad50= ""
        if val(dev) = 0 rad50= "000":return
        decimal = val(dev)
        rad50= mid$(valid'rad50,(int(decimal/1600)+1),1)
        decimal = decimal - (int(decimal/1600)*1600)
        rad50= rad50+ mid$(valid'rad50,(int(decimal/40)+1),1)
        decimal = decimal - (int(decimal/40)*40)
        rad50= rad50+ mid$(valid'rad50,decimal+1,1)
        return

dsp:
        ?tab(-1,0)
        ?"Rock Dump of : ";ucs(file'name);

        if idx'ida'fre'ptr'2 = 0 and idx'rec'alloc'2 = 0 then &
        ?"     ** File is secondary directory  ** " else ?

        ?" ______________________________________________________________"
        ?" Base";tab(24);"decimal";tab(40);"Octal";tab(50);"  Hexidecimal"
        ?" --------------------------------------------------------------"

        if rad50 = "000" then &
        ?" Data file device       ";same:goto ds1

        ?" Data file device       ";rad50;str(unt'no);":"
ds1:

   decimal = idx1:call cvt'dec
        ?" exclusive use         ";idx1;&
        tab(40);oct'val;tab(55);hex'val

   decimal = update2 + (update1 * 65536):call cvt'dec
        ?" update counter        ";update2+(update1 * 65536);&
        tab(40);oct'val;tab(55);hex'val

   decimal = idx'rec'siz:call cvt'dec
        ?" record size           ";idx'rec'siz;&
        tab(40);oct'val;tab(55);hex'val

   decimal = idx'key'siz:call cvt'dec
        ?" key size              ";idx'key'siz;&
        tab(40);oct'val;tab(55);hex'val

   decimal = idx'dir'siz:call cvt'dec
        ?" directory entry size  ";idx'dir'siz;&
        tab(40);oct'val;tab(55);hex'val

   decimal = idx'dir'ent:call cvt'dec
        ?" entries per index blk ";idx'dir'ent;&
        tab(40);oct'val;tab(55);hex'val

   decimal = idx'key'type:call cvt'dec
        ?" key type              ";idx'key'type;&
        tab(40);oct'val;tab(55);hex'val

   decimal = idx'key'pos:call cvt'dec
        ?" key position          ";idx'key'pos;&
        tab(40);oct'val;tab(55);hex'val

   decimal = ida'blk'fac:call cvt'dec
        ?" blocking factor       ";ida'blk'fac;&
        tab(40);oct'val;tab(55);hex'val

   decimal = idx'ida'fre'ptr'2:call cvt'dec
        ?" data file free pointer";idx'ida'fre'ptr'2;&
        tab(40);oct'val;tab(55);hex'val

   decimal = idx'ida'fre'cnt'2:call cvt'dec
        ?" data file free count  ";idx'ida'fre'cnt'2;&
        tab(40);oct'val;tab(55);hex'val

   decimal = idx'fre'lst'ptr'2:call cvt'dec
        ?" index free pointer    ";idx'fre'lst'ptr'2;&
        tab(40);oct'val;tab(55);hex'val

   decimal = idx'fre'cnt'2:call cvt'dec
        ?" index free count      ";idx'fre'cnt'2;&
        tab(40);oct'val;tab(55);hex'val

   decimal = idx'rec'alloc'2:call cvt'dec
        ?" records allocated     ";idx'rec'alloc'2;&
        tab(40);oct'val;tab(55);hex'val

   decimal = top'dir'block'2:call cvt'dec
        ?" top directory block   ";top'dir'block'2;&
        tab(40);oct'val;tab(55);hex'val

   decimal = dir'blk'siz:call cvt'dec
        ?" directory block size  ";dir'blk'siz;&
        tab(40);oct'val;tab(55);hex'val

        input line;x

        return

prt:
        ?" Printing to file `ismdmp.prt'"

        open #2,"ismdmp.prt",output
        ?#2,"Rock Dump of : ";ucs(file'name);

        if idx'ida'fre'ptr'2 = 0 and idx'rec'alloc'2 = 0 then &
        ?#2,"     ** File is secondary directory  ** " else ?#2 

        ?#2," ______________________________________________________________"
        ?#2," Base";tab(24);"decimal";tab(40);"Octal";tab(50);"  Hexidecimal"
        ?#2," --------------------------------------------------------------"

        if rad50 = "000" then &
        ?#2," Data file device       ";same:goto pr1

        ?#2," Data file device       ";rad50;str(unt'no);":"
pr1:

   decimal = idx1:call cvt'dec
        ?#2," exclusive use         ";idx1;&
        tab(40);oct'val;tab(55);hex'val

   decimal = update2 + (update1 * 65536):call cvt'dec
        ?#2," update counter        ";update2+(update1 * 65536);&
        tab(40);oct'val;tab(55);hex'val

   decimal = idx'rec'siz:call cvt'dec
        ?#2," record size           ";idx'rec'siz;&
        tab(40);oct'val;tab(55);hex'val

   decimal = idx'key'siz:call cvt'dec
        ?#2," key size              ";idx'key'siz;&
        tab(40);oct'val;tab(55);hex'val

   decimal = idx'dir'siz:call cvt'dec
        ?#2," directory entry size  ";idx'dir'siz;&
        tab(40);oct'val;tab(55);hex'val

   decimal = idx'dir'ent:call cvt'dec
        ?#2," entries per index blk ";idx'dir'ent;&
        tab(40);oct'val;tab(55);hex'val

   decimal = idx'key'type:call cvt'dec
        ?#2," key type              ";idx'key'type;&
        tab(40);oct'val;tab(55);hex'val

   decimal = idx'key'pos:call cvt'dec
        ?#2," key position          ";idx'key'pos;&
        tab(40);oct'val;tab(55);hex'val

   decimal = ida'blk'fac:call cvt'dec
        ?#2," blocking factor       ";ida'blk'fac;&
        tab(40);oct'val;tab(55);hex'val

   decimal = idx'ida'fre'ptr'2:call cvt'dec
        ?#2," data file free pointer";idx'ida'fre'ptr'2;&
        tab(40);oct'val;tab(55);hex'val

   decimal = idx'ida'fre'cnt'2:call cvt'dec
        ?#2," data file free count  ";idx'ida'fre'cnt'2;&
        tab(40);oct'val;tab(55);hex'val

   decimal = idx'fre'lst'ptr'2:call cvt'dec
        ?#2," index free pointer    ";idx'fre'lst'ptr'2;&
        tab(40);oct'val;tab(55);hex'val

   decimal = idx'fre'cnt'2:call cvt'dec
        ?#2," index free count      ";idx'fre'cnt'2;&
        tab(40);oct'val;tab(55);hex'val

   decimal = idx'rec'alloc'2:call cvt'dec
        ?#2," records allocated     ";idx'rec'alloc'2;&
        tab(40);oct'val;tab(55);hex'val

   decimal = top'dir'block'2:call cvt'dec
        ?#2," top directory block   ";top'dir'block'2;&
        tab(40);oct'val;tab(55);hex'val

   decimal = dir'blk'siz:call cvt'dec
        ?#2," directory block size  ";dir'blk'siz;&
        tab(40);oct'val;tab(55);hex'val
        ?#2,chr(12)
        close #2
        return


file'not'found:
        ?chr(7);"File ` ";ucs(file'name);" ' Does Not Exist "
        goto st1

utility'menu:
                ?tab(-1,0);
        
                ?"Utility Menu - Currently ` ";ucs(file'name);" ' is Open "
                if data'file ="" goto ut1
                ?"               Currently ` ";ucs(data'file);" ' is Open "
ut1:            ?
                ?"1) Redisplay Rock Data       "
                ?"2) Print Rock Data           "
                ?"3) Screen Dump Index         "
                ?"4) Print Index               "
                ?"5) Open Associated Data File "
                ?"6) Close Data File           "
                ?"7) --------------------------"
                ?"8) --------------------------"
                ?"9) Close Current File        "

        input "Enter Selection  ";x
        if x = 9 chain "ismdmp"
        on x call dsp,prt,scn'dmp,not,opn'data,close'data

        goto utility'menu

not: ?"not available":return


scn'dmp:        lookup file'name,found
                found = -found
                ptr = 1                 ! setup to bypass rock

commnd:
        ?:input "Enter Command or ?  ";command

        command = ucs(command)

        if command ="?" then call help'menu:goto commnd
        if command ="+" then call increment:goto r'i'd
        if command ="-" then call decrement:goto r'i'd
        if command ="R" then call dsp'rock :goto commnd
        if command ="C" then call chain'ptr:goto r'i'd
        if command ="#" then call get'record:goto commnd
        if command ="B" then call get'block:goto r'i'd
        if command ="T" then call get'time : goto commnd
        if command ="M" then return

r'i'd:  
           read #1,work'record          

                dsp'cnt = 0                     
                chn'ptr = 0

                for wk'ptr = 1 to 512 step idx'dir'siz

                        wrk'key = work'record[wk'ptr;idx'dir'siz]

                        if asc(work'record[wk'ptr;1]) < 32 &
                        then dsp'cnt =idx'dir'ent&
                        :goto dsp'c
 
                        if asc(work'record[wk'ptr;1]) > 126&
                          chn'ptr = wrk'key[idx'key'siz+1;4]&
                         :dsp'key = dashes[1;idx'key'siz]&
                         :goto dsp'chain

                        dsp'key = work'record[wk'ptr;idx'key'siz]

dsp'd:                  dsp'ptr = &
                        right(wrk'key[1,idx'dir'siz],4)

                       print dsp'key;"   ";&
                        dsp'ptr'1 using "#ZZZZ";"  ";&
                        dsp'ptr'2 using "#ZZZZ";"  "

                 dsp'cnt = dsp'cnt + 1

dsp'c:         if dsp'cnt = idx'dir'ent then &
                  chn'ptr'2 = 0&
                 :dsp'key   = dashes[1;idx'key'siz]&
                 :wk'ptr    = 512:goto dsp'chain

                next wk'ptr

nxt'scn:        goto commnd


help'menu:      ?tab(-1,0);"Help Menu"
                ?
                ?" ? This menu"
                ?" + Increment Block"
                ?" - Decrement Block"
                ?" B Enter Block Number"
                ?" R display Rock"
                ?" C Chain to next block"
                ?" # Get Associated Record"
                ?" M Master Menu"
                return

increment:      ptr = ptr + 1
                if ptr > found ptr = 1
                return

decrement:      ptr = ptr - 1
                if ptr = 0 then call dsp
                ptr = 1
                return

dsp'rock:       ptr = 0
                call dsp
                ptr = 1
                return

get'block:      input"Enter Block Number ";ptr
                if ptr > found goto get'block
                return


get'record:     if data'file'open = 0 call data'not'open:return

                input"Enter Record Number ";data'ptr

                if data'ptr > idx'rec'alloc'2  goto get'record

                call read'data

                call fmt'record
                return

chain'ptr:
                if chn'ptr'2 = 0 then ptr = 1:return
                if chn'ptr'2 > found then chn'ptr'2 = 0 :return
                ptr = val(chn'ptr'2)
                goto r'i'd

dsp'chain:
                if chn'ptr'2 > found then chn'ptr'2 = 0 
                idx'ptr = val(chn'ptr'2)
                if idx'ptr = 0 then&
                print dsp'key;"          ":goto commnd
                print dsp'key;"          ";&
                chn'ptr'2 using "#ZZZZ";"  ";"Chain Pointer"
                goto commnd

opn'data:
                if idx'ida'fre'ptr'2 = 0 and idx'rec'alloc'2 = 0 then &
                call req'name:goto open'data
                y = instr(1,file'name,".idx")
                data'file = file'name
                data'file[y;4] = ".ida"

data'lookup:    lookup data'file,found'data
                found'data = -found'data
                if found'data = 0 call read'rad:goto data'lookup

open'data:      if data'file'open  return
                open #2,data'file,random,512,data'ptr   
                data'file'open = 1
                return

read'rad:       data'file = rad50+str(unt'no)+":"+data'file
                return          

req'name:       ?:input "Enter Data File Name  ";data'file
                return

fmt'record:     for x = 1 to 512 

                  if asc(data'record[x;1]) < 32 then &
                  data'record[x;1] = "."

                next x                  

                prt'data'record = &
                data'record[(data'rec'ptr*idx'rec'siz)+1;idx'rec'siz]

                prt'data'record = prt'data'record + space(512)

                xcall strip,prt'data'record

                ?prt'data'record

                prt'data'record = ""

                return

read'data:      block'ptr =(data'ptr/ida'blk'fac)         

                x = int(block'ptr)                        

                data'rec'ptr = (block'ptr - x)            

                if data'rec'ptr = 0 then block'ptr = block'ptr -1

                data'rec'ptr =(data'rec'ptr * ida'blk'fac)-1

                if data'rec'ptr < 0 then data'rec'ptr = 0

                data'ptr = block'ptr

                read #2,data'record

                return

close'data:
                if data'file'open = 0 return
                close #2
                data'file = ""
                data'file'open = 0
                return

data'not'open:
        ?chr(7);"Data File Is Not Open  M-5"
        return

get'time:
        xcall daytim,ddate,ttime
        ?ddate;"     ";ttime
        return