!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!! !!! !!! 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 !!!! !!! !!! !!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!! 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) map1 ROW,b,1 ! Row for Border Routine map1 VROW,b,1 ! Row of Verification Display map1 CROW,b,1 ! Row of Centering Routine map1 TROW,b,1 ! Box Draw Routine Top Row map1 BROW,b,1 ! Box Draw Routine Bottom Row map1 TCOL,b,1 ! Box Draw Routine Top Column map1 BCOL,b,1 ! Box Draw Routine Bottom Column map1 LROW,b,1 ! Link Display Routine Current Row map1 SROW,b,1 ! Screen Output Row map1 VCOL,f,6 ! Verification Output Column !!!!!!!!!!!!!!!!!!!!!!! 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 SELTYP: PROCIDX=0 call DISFUN MAXCHC=2 : call SUBMNU call CLRMNU on CHOICE%+1 goto EXIALL, CONFIRM, 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 PHASE2: ? tab(9,44);space(35); VROW=9 : call VERIFY SRCH$="0" : STKPNT=0 call BLDARY STKPNT1=STKPNT PHASE3: VROW=9 : call VERIFY call FINAL MENU: call DISMNU MAXCHC=5 : call SUBMNU call CLRMNU on CHOICE%+1 goto EXIALL, PREBUILD, CHKCHN, CHKIDX, ASKEXP, DUMPBI 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 REDISP: call STATS call OUTNAM call MASK2 HIGH=1 : call PRCLNK call DISNUM ? tab(9,43);space(35); goto PHASE3 DUMPBI: open #3,ROOT+".BMP",output for III=1 to NUMBLKS ? #3,BITMAP(III) next III close #3 goto MENU FIXIDX: HEADING$="ISAM DIAGNOSTIC SYSTEM - IDX FILE" : call HEADING call OUTNAM filebase 0 HIGH=1 : MAXREC=(IDXSIZ*-1)-1 if MAXREC>NUMRECS then call OVERFLOW : goto GETNAM call PRCLNK EMPTY=0 : INUSE=0 : I'NUM=0 : call DISIDX call OPNIDX for I'NUM=1 to (IDXSIZ*-1)-1 if ARRAY(I'NUM)="" then ARRAY(I'NUM)="0" read #1, IDXCHK if IDXIDX#0 & then ARRAY(I'NUM)="2" : INUSE=INUSE+1 & else EMPTY=EMPTY+1 : & if IDXPNT=0 & then ARRAY(I'NUM)="3" & else ARRAY(IDXPNT)="1" if I'NUM/INCR=int(I'NUM/INCR) & then call DISIDX next I'NUM close #1 filebase 1 I'NUM=I'NUM-1 : call DISIDX HIGH=0 : call PRCLNK ? tab(9,44);space(35); VROW=9 : call VERIFY SRCH$="0" : STKPNT=0 call BLDARY STKPNT1=STKPNT FIXIDX3: VROW=9 : call VERIFY call FINAL if STKPNT1=0 then ERRTYP=8 : call ABORT : goto MENU if STKPNT1>1 then ERRTYP=7 : call ABORT : goto EXIALL if STKPNT1=1 & then if STACK(1)=IDX'POINT & then goto EXIALL & else goto CONFIX2 CONFIX2: HEADING$="DO YOU WISH TO REWRITE THE ROCK ? (Y/N)" : call PROMPT on LCLOPT goto DOFIX2, EXIALL, EXIALL, EXIALL DOFIX2: call GETROK NUMBER=STACK(1) call UPDATE IDX'FREEPNT(1)=FIRST : IDX'FREEPNT(2)=SECOND call DMPROK call STATDAT goto EXIALL MEMERR: ? chr(7);"Insufficient Memory to Run ISMFIX" EXIALL: ? tab(22,1);tab(-1,28);tab(-1,8);"Program Ends....." HEADING$=SPACE(30) : call HEADING end !!!!!!!!!!!!!!!!!!!! Program Subroutines !!!!!!!!!!!!!!!!!!!! ABORT: HEADING$="CANNOT REWRITE ROCK.."+ERRORS(ERRTYP)+"...ANY KEY" : call PROMPT ALLOW=0 return WARNING: BADCNT=-1 HEADING$="WARNING..."+ERRORS(ERRTYP)+"...ANY KEY" : call PROMPT return 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 LINK1>STKPNT1 then return call CLRSTK goto LNKLOP return CLRSTK: for OOO=1 to STKPNT1 ? tab(19+OOO,10);space(30); next OOO return OUTNAM: CROW=2 : SPLINE=FUNCTIONS(1-PROCIDX)+" File: "+FILNAME : call CNTBOX return STATS: call STATSCR call STATDAT ROW=1 : call BORDER 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; CVTFLG=-1 : OFF=10 : FIRST=IDA'FREEPNT(1) : SECOND=IDA'FREEPNT(2) : call DISLNG CVTFLG=00 : OFF=11 : FIRST=IDA'FREECNT(1) : SECOND=IDA'FREECNT(2) : call DISLNG CVTFLG=-1 : OFF=12 : FIRST=IDX'FREEPNT(1) : SECOND=IDX'FREEPNT(2) : call DISLNG : IDX'POINT=DECIMAL CVTFLG=00 : OFF=13 : FIRST=IDX'FREECNT(1) : SECOND=IDX'FREECNT(2) : call DISLNG CVTFLG=00 : OFF=14 : FIRST=ALLOCATED(1) : SECOND=ALLOCATED(2) : call DISLNG CVTFLG=00 : OFF=15 : FIRST=UPDCNT(1) : SECOND=UPDCNT(2) : call DISLNG CVTFLG=-1 : OFF=16 : FIRST=TOP'DIRPNT(1) : SECOND=TOP'DIRPNT(2) : call DISLNG OUTFLG=0 return 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 OCTAL: III=TEMP call CONVRT ? tab(SROW+OFF,50);"("; str(OCT);")" CVTFLG=0 return GETDEV: DEVR50=RAD50DEV TEMP=int(DEVR50/40) DEVICE$=RAD$[DEVR50-TEMP*40+1;1] DEVR50=TEMP TEMP=int(DEVR50/40) DEVICE$=RAD$[DEVR50-TEMP*40+1;1]+DEVICE$ TEMP=int(DEVR50/40) DEVICE$=RAD$[TEMP+1;1]+DEVICE$+str(DEVICE'NUM)+":" return UPDATE: if NUMBERLBRAK 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 READ32: read #10, REC32 KEY=REC32[KEY'POSITION;SIZE'KEY] return READ48: read #10, REC48 KEY=REC48[KEY'POSITION;SIZE'KEY] return READ51: read #10, REC51 KEY=REC51[KEY'POSITION;SIZE'KEY] return READ64: read #10, REC64 KEY=REC64[KEY'POSITION;SIZE'KEY] return READ102: read #10, REC102 KEY=REC102[KEY'POSITION;SIZE'KEY] return READ128: read #10, REC128 KEY=REC128[KEY'POSITION;SIZE'KEY] return READ170: read #10, REC170 KEY=REC170[KEY'POSITION;SIZE'KEY] return READ256: read #10, REC256 KEY=REC256[KEY'POSITION;SIZE'KEY] return READ512: read #10, REC512 KEY=REC512[KEY'POSITION;SIZE'KEY] return BORDER: TROW=ROW : TCOL=43 : BROW=TROW+4 : BCOL=79 : call DRWBOX ? tab(-1,23);tab(ROW+2,43);tab(-1,44); for III=45 to 79 ? tab(-1,46); next III ? tab(-1,43); if BISECT=0 then goto EXTBRD ? tab(TROW,61);tab(-1,42);tab(TROW+1,61);tab(-1,47); ? tab(TROW+2,61);tab(-1,48);tab(TROW+3,61);tab(-1,47); ? tab(TROW+4,61);tab(-1,45); BISECT=0 EXTBRD: ? tab(-1,24); return CNTBOX: if CATR=0 then CATR=32 ? tab(CROW,44);space(35);tab(CROW,78);tab(-1,33); PLINE=SPACES PLINE[17-int(len(SPLINE)/2);len(SPLINE)]=SPLINE ? tab(CROW,44);tab(-1,CATR);tab(-1,11);PLINE;tab(-1,12); CATR=0 return MASK: ? tab(2,45);tab(-1,11);"ISAM IDX File: ";tab(-1,12);FILNAME; MASK2: ? tab(4,45);tab(-1,11);"Display Increment: ";tab(4,65);tab(-1,12);INCR using "####";space(2) 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 UPDCNT: NUMBER=INUSE call UPDATE ALLOCATED(1)=FIRST : ALLOCATED(2)=SECOND NUMBER=EMPTY call UPDATE IDA'FREECNT(1)=FIRST : IDA'FREECNT(2)=SECOND return DISMNU: call CLRMNU TROW=16 : TCOL=43 : BCOL=79 : BROW=22 : call DRWBOX for OPT=1 to 5 ? tab(16+OPT,49);"("str(OPT);") ";OPTIONS(OPT); next OPT return DISFUN: call CLRMNU TROW=18 : TCOL=43 : BCOL=79 : BROW=21 : call DRWBOX for OPT=1 to 2 ? tab(18+OPT,49);"("str(OPT);") Process ";FUNCTIONS(OPT);" Free List"; next OPT return GETFREE: FIRST=ALLOCATED(1) SECOND=ALLOCATED(2) call DISLNG MAXREC=TEMP : ALLOC=TEMP FIRST=IDA'FREECNT(1) SECOND=IDA'FREECNT(2) call DISLNG MAXREC=MAXREC+TEMP : FREE=TEMP 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 PROMPT: HEADING$=" * * "+HEADING$+" * * " PLACER=int((72-len(HEADING$))/2)+len(HEADING$)+2 ? tab(23,PLACER);tab(-1,33);tab(23,int((72-len(HEADING$))/2));tab(-1,32);HEADING$;tab(-1,33); PLACER=PLACER+1 : I$=" " CTL$="23 "+(PLACER using "#Z")+" 00 01" call INPUT : LCLOPT=4-instr(1,"N Y",I$) ? tab(23,1) tab(-1,9); return