!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! !!!
!!! ISMFIX - Repair corrupted IDA or IDX Pointer !!!
!!! !!!
!!! Copyright (C) 1990, 1992 by Marc Sheppard !!!
!!! !!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! !!!
!!! NOTE: In it's stock form, this program will accomodate an IDA File !!!
!!! of 100K records or an IDX file of 100K Blocks. If more room !!!
!!! is needed modify ONLY the following: !!!
!!! NUMRECS,f,6,A - To new maximum of A !!!
!!! ARRAY(B),s,1 - To B=A !!!
!!! BITSEG(C) - To A/10K=C !!!
!!! NUMBLKS,f,6,D - To D=C !!!
!!! DO NOT MODIFY the size of variable BITMAP !!!
!!! WARNING: You will require memory partition of A+32K to assure !!!
!!! proper operation. DO NOT deviate from the above instruc- !!!
!!! tions when modifying the Master Bitmap Variables !!!! !!!
!!! !!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
map1 NUMRECS,f,6,100000 ! change this
map1 MASTER'BITMAP
map2 ARRAY(100000),s,1 ! change this
map1 ARYSTR,@MASTER'BITMAP
map2 BITSEG(10) ! change this
map3 BITMAP,s,10000 ! DO NOT CHANGE !!!
map1 NUMBLKS,f,6,10 ! Change this
!!!!!!!!!!!!!!! Program Map Statements !!!!!!!!!!!!!!!
PROGRAM ISMFIX,1.1(5)
map1 ERRORS(10),s,40
ERRORS(1)="USED RECORD FOUND ON ACTIVE LIST"
ERRORS(2)="ACTIVE LIST HAS MULTIPLE TERMINATORS"
ERRORS(3)="RECORD HAS MULTIPLE POINTERS"
ERRORS(4)="LINK ERRORS EXIST"
ERRORS(5)="FREE COUNT MISMATCH"
ERRORS(6)="ALLOC COUNT MISMATCH"
ERRORS(7)="MULTIPLE FREE RECORDS"
ERRORS(8)="NO LINK TO BASE FOUND"
ERRORS(9)="POINTER TO USED RECORD"
map1 FATAL(9),b,1 ! Fatal Error Types
FATAL(2)=1 ! Disallow rewriting
FATAL(3)=1 ! Of Rock.
map1 OPTIONS(5),s,20
OPTIONS(1)="Rewrite Isam Rock"
OPTIONS(2)="Verify Free List"
OPTIONS(3)="Verify Primary Key"
OPTIONS(4)="Rebuild Free List"
OPTIONS(5)="Dump Bitmap to Disk"
map1 FUNCTIONS(2),s,03
FUNCTIONS(1)="IDA"
FUNCTIONS(2)="IDX"
map1 COMPARE,b,1,-1 ! Key Match Mode Indicator
map1 SRCH$,s,1 ! Bitmap Search String
map1 HEADING$,s,78 ! Utility Heading String
map1 KEY,s,80 ! Isam Lookup Key
map1 KEY2,s,80 ! Isam Comparison Key
map1 MASK,s,10,"##########" ! Statistics Output Mask
map1 INPFLG,f,6,0 ! User Input Flag
map1 DOTS$,s,80,"................................................................................"
map1 CTL$ ! Input Routine Input Variables
map2 I'ROW,s,2
map2 I'SPACE1,s,1
map2 I'COL,s,2
map2 I'SPACE2,s,1
map2 I'MIN,s,2
map2 I'SPACE3,s,1
map2 I'MAX,s,2
map2 I'SPACE4,s,1
map1 I$,s,80,"" ! Input Routine Output Variable
map1 SPACES,s,80,space(80) ! White Space
map1 WORK'STACKS(50) ! Work Stacks 1-3
map2 STACK,b,3 !
map2 STACK2,b,3 !
map2 STACK3,b,3 !
map1 STKPNT,f,6 ! Work Stack Pointer
map1 RECORD,x,8 ! Isam IDA Record
map1 CHECK,@RECORD !
map2 RBUMP(2),b,1 ! Active/Delete List
map2 RLINK,b,2 !
map1 NULLER,@RECORD
map2 BLANK,s,2
map1 FILNAME,s,06,DOTS$ ! Change to string of 25 and
! call parsing routine if
! installing external input Xcall
map1 DEVNAM,s,6 ! Device Name from Parse Routine
map1 ROOT,s,6 ! File Root Name "" "" ""
map1 PPN,s,9 ! PPN "" "" "" ""
map1 DEVICE$,s,6 ! File Device
map1 COLON,f,6 ! Colon Position "" "" ""
map1 LBRAK,f,6 ! Left Bracket Position "" "" ""
map1 RBRAK,f,6 ! Right Bracket Position "" "" ""
map1 BASE,f,6,(2**16) ! Base Multiplier
map1 IDXCHK ! Idx record
map2 IDXIDX,b,2
map2 IDXPNT,b,2
map1 I'ROCK ! isam rock
map2 RAD50DEV,b,2 ! ida dev (rad50)
map2 DEVICE'NUM,b,2 ! device number
map2 FILLER,x,2 ! undefined area
map2 UPDCNT(2),b,2 ! update counter
map2 SIZE'DATA,b,2 ! size of data record
map2 SIZE'KEY,b,1 ! size of key
map2 SIZE'ENTRY,b,1 ! size of dir entry
map2 ENTRY'PERBLK,b,1 ! entries per dir blk
map2 KEY'TYPE,b,1 ! type of key
map2 KEY'POSITION,b,2 ! key position
map2 BLOCKING,b,2 ! blocking factor
map2 IDA'FREEPNT(2),b,2 ! ida free list pnt
map2 IDA'FREECNT(2),b,2 ! ida free counter
map2 IDX'FREEPNT(2),b,2 ! idx free list pnt
map2 IDX'FREECNT(2),b,2 ! idx free count
map2 ALLOCATED(2),b,2 ! records allocated
map2 FILLE2,x,8 ! undefined area
map2 TOP'DIRPNT(2),b,2 ! top dir block pointer
map2 FILLE3,x,8 ! undefined area
map2 SIZE'DIRBLK,b,2 ! size of dir block
map2 FILLE4,x,450 ! undefined area
map1 FIRST,f,6 ! first binary
map1 SECOND,f,6 ! second binary
map1 SIZES(20),b,2 ! record sizes for key checking
SIZES(1)=32
SIZES(2)=48
SIZES(3)=51
SIZES(4)=64
SIZES(5)=102
SIZES(6)=128
SIZES(7)=170
SIZES(8)=256
SIZES(9)=512
map1 NUMSIZ,b,1,09 ! number of supported sizes -
! change when adding new sizes
map1 REC32,x,32 ! AlphaBasic does not support
map1 REC48,x,48 ! Substring Modifiers in record
map1 REC51,x,51 ! reads. Must define each record
map1 REC64,x,64 ! size !
map1 REC102,x,102
map1 REC128,x,128
map1 REC170,x,170
map1 REC256,x,256
map1 REC512,x,512
map1 RAD$,s,50," ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789" ! rad50 conversion string
map1 DEVR50,f,6 ! RAD50 conversion Temp Variable
map1 OCT,f,6,0 ! RAD50 Conversion Routine Variable
map1 OCT$,s,10,"" ! "" ""
map1 DEC,f,6,0 ! "" ""
map1 DEC$,s,10,"" ! "" ""
map1 NUMBER$,s,1,"" ! "" ""
map1 PLINE,s,33 ! Screen Output String
map1 SPLINE,s,33 ! Screen Output Sub-String
map1 INCR,f,6,1000 ! Display Increment
map1 ERRTYP,b,1 ! Error Number Encountered
map1 STKPNT1,f,6 ! Orphan Records Count/Pointer
map1 STKPNT2,f,6 ! Bad Keys Count/Pointer
map1 STKPNT3,f,6 ! Missing Keys Count/Pointer
map1 KEYERR,f,6 ! Mismatched Keys Count/Pointer
map1 IDX'POINT,b,4 ! Idx Free Pointer Holding Variable
map1 LCLOPT,f,6 ! Local Option
map1 CHOICE%,f,6 ! Global Option
map1 MAXCHC,b,1 ! Maximum Local Option Choice
map1 BLOCK,f,6 ! Loop Counter
map1 III,f,6 ! Loop Counter
map1 OOO,f,6 ! Loop Counter
map1 SSS,f,6 ! Loop Counter
map1 XX,f,6 ! Loop Counter
map1 DELREC,f,6 ! Loop Counter
map1 OPT,f,6 ! Loop Counter
map1 HIT,f,6 ! Instr Start position for Array
! evaluation
map1 SPOT,f,6 ! Instr Hit position for Array
! evaluation
map1 PLACER,f,6 ! Screen ouput placement variable
map1 CATR,b,1 ! Center Routine Display Attribute
map1 THISONE,f,6 ! Record size evaluation Pointer
map1 INVERSE,b,4 ! Screen Output Progress Variable
map1 IDXSIZ,f,6 ! Size of IDX File
map1 RECSIZ,f,6 ! Size of IDA Record
map1 MAXREC,f,6 ! Number of records being processed
map1 IDAFND,f,6 ! IDA File Lookup Return Variable
map1 ERRFLG,b,1 ! Error Return Flag for Parse Routine
map1 PROCIDX,f,6 ! Process Index File ?
map1 HIGH,b,1 ! Screen Intensity Variable
map1 BISECT,b,1 ! Bisect Flag for Border Routine
map1 R'NUM,f,6 ! Relative Record Number - IDA
map1 I'NUM,f,6 ! Relative Record Number - IDX
map1 RELKEY,f,6 ! Relative Record Number - ISAM
map1 LINK,f,6 ! Link Analysis Holding Variable
map1 LINK1,f,6 ! Link Analysis Holding Variable
map1 NUMBER,f,6 ! Link Analysis Holding Variable
map1 TEMP,f,6 ! Conversion Output variable
map1 DECIMAL,f,6 ! Conversion Holding variable
map1 OFF,b,1 ! Row Offset for Screen Output
map1 ALLOW,b,1 ! Rock Clear for Rewrite ?
map1 REPAINT,b,1 ! Output flag for Key verif routine
map1 OUTFLG,b,1 ! Output flag for conversion routine
map1 CVTFLG,b,1 ! Octal flag for conversion routine
map1 BADCNT,b,4 ! Alloc and/or Free count error
map1 ERRCNT,b,4 ! Total Fatal Errors Encountered
map1 TRMCNT,b,4 ! Total Active List Terminators Errors Encountered
map1 NEWCNT,b,4 ! New Active List Count for Rebuild
map1 KEYCNT,b,4 ! Total Active keys Encountered
map1 LCNT,b,4 ! Number of Active Links
map1 FREE,b,4 ! Number of Free Records (from Rock)
map1 EMPTY,b,4 ! Number of Free Records (Caluculated)
map1 ALLOC,b,4 ! Number of Allocated Records (from Rock)
map1 INUSE,b,4 ! Number of Allocated Records (Caluculated)
!!!!!!!!!!!!!!!!!!!!!!! Main Program Logic !!!!!!!!!!!!!!!!!!!!!!!!!
INTPRG:
if MEM<32000 then goto MEMERR
filebase 1
? tab(-1,0);tab(-1,29);tab(-1,7);
HEADING$="ISAM DIAGNOSTIC SYSTEM" : call HEADING
call STATS
GETNAM:
? tab(2,44)space(35);
call MASK
CTL$="02 60 00 06" : call INPUT
call MASK
if INPFLG then FILNAME=I$
if asc(FILNAME)=46 then goto EXIALL
call PARSE: if ERRFLG then call BEEP : goto GETNAM
lookup DEVNAM+ROOT+".IDX"+PPN, IDXSIZ
if IDXSIZ=0 &
then call BEEP:FILNAME=DOTS$:goto GETNAM
call OUTNAM
GETINC:
CTL$="04 65 00 04" : call INPUT
if INPFLG then INCR=I$
call MASK2
if INCR<1 then INCR=1000:goto GETINC
INVOKE:
? tab(-1,29);
call GETROK
call STATDAT
if DEVNAM#"" then if DEVICE$="" then DEVICE$=DEVNAM
lookup DEVICE$+ROOT+".IDA"+PPN, IDAFND
if IDAFND=0 then PROCIDX=-1 : goto PROCIDX
PROCIDX:
HEADING$="DO YOU WISH TO PROCESS THIS IDX FILE ? (Y/N)" : call PROMPT
PROCIDX=(LCLOPT=1)
on LCLOPT goto FIXIDX, EXIALL, GETNAM, PROCIDX
CONFIRM:
HEADING$="DO YOU WISH TO PROCESS THIS IDA FILE ? (Y/N)" : call PROMPT
on LCLOPT goto PHASE1, EXIALL, GETNAM, CONFIRM
PHASE1:
RECSIZ=SIZE'DATA
if PROCIDX then goto FIXIDX
HEADING$="ISAM DIAGNOSTIC SYSTEM - IDA FILE" : call HEADING
call OUTNAM
if IDAFND=0 then call SECONDARY : goto GETNAM
call OPNIDA
call GETFREE
if MAXREC>NUMRECS then call OVERFLOW : close #100 : goto GETNAM
HIGH=1 : call PRCLNK
R'NUM=0: call DISNUM
for R'NUM=1 to MAXREC
if ARRAY(R'NUM)="" then ARRAY(R'NUM)="0"
read #100, RECORD
FIRST=RBUMP(1) : SECOND=RLINK : call DISLNG
LINK=TEMP
if RBUMP(2)#0 &
then call SETUSE &
else call SETLNK
if R'NUM/INCR=int(R'NUM/INCR) &
then call DISNUM
NEXNUM:
next R'NUM
R'NUM=R'NUM-1
call DISNUM
close #100
HIGH=0 : call PRCLNK
PREBUILD:
if STKPNT1=0 then ERRTYP=8 : call ABORT : goto MENU
if STKPNT1=1 then goto FIXIT
MULTIPLES:
ERRTYP=7 : call ABORT
call DISLNK
ASKEXP:
HEADING$="DO YOU WISH TO REBUILD THE FREE LIST ? (Y/N)" : call PROMPT
on LCLOPT goto EXPLORE, MENU, MENU, ASKEXP
EXPLORE:
call REBUILD
call STATDAT
goto BUFFER
CHKIDX:
HEADING$="DO YOU WISH TO VERIFY PRIMARY KEY FILE ? (Y/N)" : call PROMPT
on LCLOPT goto CHKIDX2, MENU, MENU, CHKIDX
CHKIDX2:
call CHKKEY
goto BUFFER
BUFFER:
HEADING$="ANY KEY TO CONTINUE":call PROMPT
goto MENU
FIXIT:
ALLOW=-1 : BADCNT=0
if ERRCNT then ERRTYP=4 : call ABORT
if EMPTY#FREE then ERRTYP=5 : call WARNING
if ALLOC#INUSE then ERRTYP=6 : call WARNING
if ALLOW=0 then goto EXIALL
CONFIX:
HEADING$="DO YOU WISH TO REWRITE THE ROCK ? (Y/N)" : call PROMPT
on LCLOPT goto DOFIX, MENU, MENU, CHKCHN
DOFIX:
call GETROK
NUMBER=STACK(1)
call UPDATE
IDA'FREEPNT(1)=FIRST : IDA'FREEPNT(2)=SECOND
call DMPROK
if BADCNT then call UPDCNT
call STATDAT
goto BUFFER
CHKCHN:
HEADING$="DO YOU WISH TO VERIFY FREE LIST ? (Y/N)" : call PROMPT
on LCLOPT goto DOCHK, MENU, MENU, CHKCHN
DOCHK:
CROW=9 : SPLINE="VERIFY FREE LIST..PLEASE WAIT" : call CNTBOX
call OPNIDA
HIGH=1 : call PRCLNK2
FIRST=IDA'FREEPNT(1) : SECOND=IDA'FREEPNT(2) : call DISLNG
call DISNUM
LCNT=0
CHNLOP:
if TEMP=0 then goto EXTCHK
if instr(1,"2",ARRAY(TEMP)) then ERRTYP=1 : call WARNING
R'NUM=TEMP
read #100, RECORD
FIRST=RBUMP(1) : SECOND=RLINK : call DISLNG
call DISNUM
LCNT=LCNT+1
goto CHNLOP
EXTCHK:
call DISNUM
? tab(9,44);space(35);
? tab(9,45);tab(-1,11);"Number of Active Links:";tab(-1,12);LCNT using "######";
close #100
goto BUFFER
BLDARY:
STKPNT=0
for BLOCK=1 to NUMBLKS
HIT=1
PARSER:
SPOT=instr(HIT,BITMAP(BLOCK),SRCH$)
if SPOT=0 then goto NEXCHNK
call PUSH
HIT=SPOT+1
goto PARSER
NEXCHNK:
next BLOCK
return
PUSH:
STKPNT=STKPNT+1
if SRCH$="0" &
then STACK(STKPNT)=SPOT+(10000*(BLOCK-1)) &
else if SRCH$="4" &
then STACK2(STKPNT)=SPOT+(10000*(BLOCK-1)) &
else STACK3(STKPNT)=SPOT+(10000*(BLOCK-1))
return
OVERFLOW:
call BEEP
HEADING$="NUMBER OF RECORDS WILL OVERFLOW ARRAY...ANY KEY" : call PROMPT
return
SECONDARY:
call BEEP
HEADING$="FILE IS NOT A PRIMARY INDEX...ANY KEY" : call PROMPT
return
CONVRT:
DEC=III
OCT$=0 using "#########Z"
for XX=9 to 1 step-1
if DEC<(8^XX) then goto NEXCON
NUMBER$=str(int(DEC/(8^XX)))
OCT$[10-XX;1]=NUMBER$
DEC=DEC-(VAL(NUMBER$)*8^XX)
NEXCON:
next XX
NUMBER$=DEC using "#"
OCT$[10;1]=NUMBER$
OCT=val(OCT$)
return
DISLNK:
TROW=19 : TCOL=1 : BCOL=41 : BROW=23 : call DRWBOX
LINK1=1
LNKLOP:
LROW=0
for OOO=LINK1 to LINK1+2 min STKPNT1
LROW=LROW+1
III=STACK(OOO) : call CONVRT
? tab(19+LROW,10);III using "#######";" ";OCT using "########";
next OOO
HEADING$="ANY KEY" : call PROMPT
LINK1=LINK1+3
if LCLOPT=2 or LIN
K1>STKPNT1 then return
call CLRSTK
goto LNKLOP
return
CLRSTK:
for OOO=1 to STKPNT1
? tab(19+OOO,10);space(30);
next OOO
return
STATSCR:
OUTFLG=-1 : SROW=1
TROW=1 : TCOL=1 : BCOL=41 : BROW=18 : call DRWBOX
? tab(-1,11);
? tab(SROW+1,3);"Data File Device:";
? tab(SROW+2,3);"Size of data record:";
? tab(SROW+3,3);"Size of dir entry:";
? tab(SROW+4,3);"Size of dir block:";
? tab(SROW+5,3);"Size of key:";
? tab(SROW+6,3);"Type of key:";
? tab(SROW+7,3);"Entries per dir block:";
? tab(SROW+8,3);"Record key position:";
? tab(SROW+9,3);"Blocking factor:";
? tab(SROW+10,3);"IDA Free list pointer:";
? tab(SROW+11,3);"IDA Free count:";
? tab(SROW+12,3);"IDX Free list pointer:";
? tab(SROW+13,3);"IDX Free count:";
? tab(SROW+14,3);"Records allocated:";
? tab(SROW+15,3);"Update Counter:";
? tab(SROW+16,3);"Top dir blk pointer:";
? tab(-1,12);
return
STATDAT:
OUTFLG=-1
if RAD50DEV &
then call GETDEV &
else DEVICE$="....."
? tab(SROW+1,40-(len(DEVICE$)));DEVICE$;
if asc(DEVICE$)=46 then DEVICE$=""
? tab(SROW+2,30);SIZE'DATA using MASK;
? tab(SROW+3,30);SIZE'ENTRY using MASK;
? tab(SROW+4,30);SIZE'DIRBLK using MASK;
? tab(SROW+5,30);SIZE'KEY using MASK;
? tab(SROW+6,30);KEY'TYPE using MASK;
? tab(SROW+7,30);ENTRY'PERBLK using MASK;
? tab(SROW+8,30);KEY'POSITION using MASK;
? tab(SROW+9,30);BLOCKING using MASK;
DISLNG:
TEMP=(FIRST*BASE)+SECOND
if OUTFLG=0 then return
if CVTFLG then DECIMAL=TEMP : III=TEMP : call CONVRT : TEMP=OCT : CVTFLG=0
? tab(SROW+OFF,30);TEMP using MASK ;
return
UPDATE:
if NUMBER<BASE then FIRST=0 : SECOND=NUMBER : return
FIRST=fix(NUMBER/BASE)
SECOND=NUMBER-(FIRST*BASE)
return
GETROK:
call OPNIDX
I'NUM=1
read #1, I'ROCK
close #1
return
DMPROK:
call OPNIDX
I'NUM=1
write #1, I'ROCK
close #1
return
OPNIDX:
open #1, DEVNAM+ROOT+".IDX"+PPN, random, 512, I'NUM
return
OPNIDA:
if DEVNAM#"" then if DEVICE$="" then DEVICE$=DEVNAM
open #100, DEVICE$+ROOT+".IDA"+PPN, random, RECSIZ, R'NUM
return
OPNALL:
open #10, DEVNAM+ROOT+PPN, indexed, RECSIZ, RELKEY
return
PARSE:
! necessary ONLY if using external input routine
ERRFLG=-1
if instr(1,FILNAME,".") then return
COLON=instr(1,FILNAME,":")
LBRAK=instr(1,FILNAME,"[")
RBRAK=instr(1,FILNAME,"]")
if LBRAK then if RBRAK=0 then return
if RBRAK then if LBRAK=0 then return
if RBRAK<LBRAK then return
if LBRAK then if COLON>LBRAK then return
if COLON &
then DEVNAM=FILNAME[1,COLON] &
else DEVNAM=""
if LBRAK &
then PPN=FILNAME[LBRAK,-1] &
else PPN=""
ROOT=FILNAME[COLON+1,LBRAK-1]
ERRFLG=0
return
BEEP:
? chr(7);
return
SETUSE:
INUSE=INUSE+1
ERRTYP=0
if ARRAY(R'NUM)="1" then ERRTYP=1 : call ERRMES : ARRAY(R'NUM)="3" : return
ARRAY(R'NUM)="2"
return
SETLNK:
ERRTYP=0
EMPTY=EMPTY+1
if LINK=0 &
then TRMCNT=TRMCNT+1 : &
if TRMCNT>1 &
then ERRTYP=2 : call ERRMES : return &
else return
if ARRAY(LINK)="1" then ERRTYP=3 : call ERRMES : return
if ARRAY(LINK)="2" then ERRTYP=9 : call ERRMES : return
ARRAY(LINK)="1"
return
ERRMES:
call BEEP
ERRCNT=ERRCNT+FATAL(ERRTYP)
if FATAL(ERRTYP) &
then HEADING$="FATAL " &
else HEADING$=""
HEADING$=HEADING$+"ERROR: "+ERRORS(ERRTYP)+" @ "+str(R'NUM)
if ERRTYP=9 then HEADING$=HEADING$+" point to "+str(LINK)
call PROMPT
return
CHKIDA:
on THISONE call READ32, READ48, READ51, READ64, READ102, READ128
on THISONE-6 call READ170, READ256, READ512
return
REBUILD:
TROW=16 : TCOL=43 : BROW=18 : BCOL=79 : call DRWBOX
? tab(17,45);tab(-1,11);"Rebuilding Free List:";tab(-1,12);
INVERSE=1 : NUMBER=1 : call DISREB
NEWCNT=0
call OPNIDA : call OPNIDX
for NUMBER=MAXREC to 1 step-1
if instr(1,"235",ARRAY(NUMBER)) then goto NEXCHK
NEWCNT=NEWCNT+1
call ADDLST
NEXCHK:
INVERSE=MAXREC-NUMBER
if INVERSE/INCR=int(INVERSE/INCR) &
then call DISREB
next NUMBER
INVERSE=MAXREC : NUMBER=MAXREC : call DISREB
close #100 : close #1
call UPDCNT
call DMPROK
FIRST=IDA'FREEPNT(1) : SECOND=IDA'FREEPNT(2) : call DISLNG
STACK(1)=TEMP : STKPNT1=1
call FINAL2
return
ADDLST:
R'NUM=NUMBER
read #100, RECORD
I'NUM=1
read #1, I'ROCK
if NEWCNT=1 &
then RBUMP(1)=0 : RLINK=0 &
else RBUMP(1)=IDA'FREEPNT(1) : RLINK=IDA'FREEPNT(2)
ADDLST2:
write #100, RECORD
call UPDATE
IDA'FREEPNT(1)=FIRST : IDA'FREEPNT(2)=SECOND
I'NUM=1
write #1, I'ROCK
return
PRCLNK:
if HIGH &
then ROW=6 : call BORDER :&
CROW=9 : CATR=34 : SPLINE="BUILDING BITMAP..PLEASE WAIT" : call CNTBOX
PRCLNK2:
? tab(07,45);tab(-1,11+HIGH);"Process Links: ";
? tab(07,67);tab(-1,11);"of ";str(MAXREC);tab(-1,12);
return
FINAL:
ROW=11 : BISECT=-1 : call BORDER
FINAL2:
III=STACK(1) : call CONVRT
? tab(12,45);tab(-1,11);"In Use:";tab(-1,12);INUSE using "########";
? tab(12,63);tab(-1,11);"Free:";tab(-1,12);EMPTY using "##########";
? tab(14,45);tab(-1,11);"Next(D):";tab(-1,12);III using "#######";
? tab(14,63);tab(-1,11);"Next(O):";tab(-1,12);OCT using "#######";
return
VERIFY:
? tab(VROW,45);tab(-1,11);"Verify Bitmap: ";tab(-1,12);
? tab(VROW,61);tab(-1,12)str(STKPNT1);tab(-1,11);" pointer";
if STKPNT1>1 then ? "s";
? " found";tab(-1,12);
return
VERIFY2:
if COMPARE then goto VERIFY3
? tab(VROW,45);tab(-1,11);"Verify Bitmap: ";tab(-1,12);
? tab(VROW,61);tab(-1,12)str(STKPNT2);tab(-1,11);" error";
if STKPNT2#1 then ? "s";
? " found";tab(-1,12);
return
VERIFY3:
? tab(VROW,44);space(35);tab(-1,23);
for VCOL=1 to 2
? tab(VROW-1,43+(12*VCOL));tab(-1,23);tab(-1,42);tab(VROW,43+(12*VCOL));tab(-1,47);
? tab(VROW+1,43+(12*VCOL));tab(-1,45);
next VCOL
VERIFY3A:
? tab(-1,24);
? tab(VROW,45);tab(-1,11);"Bd Key";tab(-1,12);STKPNT2 using "###";
? tab(VROW,57);tab(-1,11);"No Key";tab(-1,12);STKPNT3 using "###";
? tab(VROW,69);tab(-1,11);"MisMat";tab(-1,12);KEYERR using "###";
return
CHKKEY:
COMPARE=-1
call CHKSIZ
if SSS#100 then goto KEYEXT
CHKKEY3:
ROW=16 : call BORDER
? tab(ROW+1,45);tab(-1,11);"Process Primary Key: ";tab(-1,12);
KEYCNT=0 : KEYERR=0
call OPNALL
call DISKEY
KEY2=""
CHKLOP:
isam #10, 7, KEY2
if erf(10) then goto EXICHK
if instr(1,"25",ARRAY(RELKEY+1))=0 &
then ARRAY(RELKEY+1)="4" &
else ARRAY(RELKEY+1)="5"
KEYCNT=KEYCNT+1
if KEYCNT/INCR=int(KEYCNT/INCR) &
then call DISKEY
if COMPARE=0 then goto CHKLOP
call CHKIDA
if KEYCNT/INCR=int(KEYCNT/INCR) &
then ? tab(ROW+3,45);KEY[1,(SIZE'KEY min 34)];
if KEY[1,SIZE'KEY]#KEY2[1,SIZE'KEY] &
then KEYERR=KEYERR+1
goto CHKLOP
EXICHK:
call DISKEY
? tab(ROW+3,44);space(35);
VROW=ROW+3
SRCH$="4" : call BLDARY : STKPNT2=STKPNT
SRCH$="2" : call BLDARY : STKPNT3=STKPNT
call VERIFY2
REPAINT=0
if STKPNT2 then call DELKEY
if STKPNT3 then REPAINT=-1 : call DELREC
close #10
if REPAINT=0 then return
call GETROK : call STATDAT : call GETFREE
INUSE=ALLOC : EMPTY=FREE
FIRST=IDA'FREEPNT(1) : SECOND=IDA'FREEPNT(2) : call DISLNG
STACK(1)=TEMP : STKPNT1=1
call FINAL2
KEYEXT:
return
DELKEY:
HEADING$="KEY DELETE NOT IMPLEMENTED. ANY KEY TO CONTINUE" : call PROMPT
return
DELREC:
HEADING$="DO YOU WISH TO DELETE KEYLESS RECORDS ? (Y/N)" : call PROMPT
on LCLOPT goto DODEL, EXTADD, EXTADD, DELREC
DODEL:
for DELREC=1 to STKPNT3
RELKEY=STACK3(DELREC)-1
call CHKIDA
isam #10, 6, KEY
ARRAY(RELKEY+1)="1"
STKPNT3=STKPNT3-1
next DELREC
call VERIFY3A
call DISKEY
EXTADD:
return
DRWBOX:
? tab(-1,23);
? tab(TROW,TCOL);tab(-1,38);
for III=1 to (BCOL-TCOL)-1
? tab(-1,46);
next III
? tab(-1,39);
for III=TROW+1 to BROW-1
? tab(III,TCOL);tab(-1,47);
? tab(III,BCOL);tab(-1,47);
next III
? tab(BROW,TCOL);tab(-1,40);
for III=1 to (BCOL-TCOL)-1
? tab(-1,46);
next III
? tab(-1,41);tab(-1,24);
return
DISNUM:
? tab(07,59);R'NUM using "#######";
return
DISIDX:
? tab(07,59);I'NUM using "#######";
return
DISREB:
? tab(17,68);tab(-1,11-(ARRAY(NUMBER)#"2"));INVERSE using "#######";tab(-1,12);
return
DISKEY:
? tab(ROW+1,68);KEYCNT using "#######";
return
CHKSIZ:
for SSS=1 to NUMSIZ
if SIZES(SSS)=RECSIZ then THISONE=SSS : SSS=99
next SSS
if SSS#100 &
then HEADING$="FILE SIZE IS NOT SUPPORTED...ANY KEY" : call PROMPT
return
CLRMNU:
for OOO=16 to 22
? tab(OOO,43);tab(-1,9);
next OOO
? tab(23,1);tab(-1,9);
return
HEADING:
? tab(-1,63);space((int((80-len(HEADING$))/2) max 1))+HEADING$+space((73-(int((80-len(HEADING$))/2) max 1)-len(HEADING$) max 1));tab(-1,129)
return
INPUT:
! Replace with a real input routine and allow global filespecs
? tab(-1,8);tab(-1,28);
I$=""
? tab(I'ROW,I'COL);DOTS$[1;I'MAX];
? tab(I'ROW,I'COL);:input "";I$
I$=ucs(I$)
if len(I$)>I'MAX then call BEEP:goto INPUT
INPFLG=(len(I$)>0)
if INPFLG &
then if len(I$)#I'MAX &
then ? tab(I'ROW,I'COL+1+len(I$));tab(-1,11);DOTS$[1,I'MAX-len(I$)];
? tab(-1,29);tab(-1,7);tab(-1,12);
return
SUBMNU:
? tab(23,48) "Please select one ... " ;
CTL$="23 71 00 01" : call INPUT
CHOICE%=I$ : if CHOICE%>MAXCHC then call BEEP : goto SUBMNU
return
