home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
forth
/
rbsrc
/
rb-ridx.scr
< prev
next >
Wrap
Text File
|
1988-04-27
|
13KB
|
1 lines
\ Build Screen 21:47 04/26/88 : MARKER ; 2 12 THRU 2 12 THRU BSAVE OVERLAY RBRIDX FORGET MARKER BYE 2 11 THRU SYSTEM-INIT SCR-INIT RBRIDX \ Variables 13:16 04/18/88 FORTH DEFINITIONS DECIMAL BSTART OVERLAY INCLUDE LCGLOBAL.DEF INCLUDE FILES.DEF INCLUDE FIELD.DEF CREATE INDICES 100 ALLOT 94 CONSTANT TYPES DICTIONARY WRK.DCT NULL DICTIONARY WRK.DAT NULL HCB T.IDX \ variables 21:47 04/26/88 0 EQU SIZE 0 EQU OFFSET 0 EQU CUR# 0 EQU ANCHOR \ make-idx 13:15 04/18/88 CREATE T.BUFF 300 ALLOT T.BUFF 300 255 FILL : MAKE-IDX ( --- ) INDICES 100 ERASE WRK.DCT D.HU @ 0 ?DO FLD.BUFF I WRK.DCT DICT-READ FLD.BUFF ?ACTIVE IF FLD.BUFF FLD.?IDX C@ IF WRK.DCT HCB>N T.IDX NAME>HCB 1 INDICES I + C! T.IDX I CHG-IDX T.IDX 0 FMAKE DROP T.IDX T.BUFF 300 FWRITE DROP T.IDX FCLOSE DROP THEN THEN LOOP ; \ compares 14:27 03/14/88 : CMP-NUM ( buffa buffb --- ret_code ) >R OFFSET + 2@ R> OFFSET + 2@ NUMCMP ; : NUM>HASH ( buffa --- ret_code ) OFFSET + 2@ DROP 149 MOD ; \ cmp-str 14:27 03/14/88 : CMP-STR ( buffa buffb --- ) >R OFFSET + SIZE STRPCK MAKELC COUNT R> OFFSET + SIZE STRPCK MAKELC COUNT STRCMP ; : STR>HASH ( buffer --- value ) OFFSET + SIZE HASH-STR ; \ idx-set 14:32 03/14/88 : IDX-STR ( 'idx --- ) ['] CMP-STR OVER IDX.CMP ! ['] STR>HASH SWAP IDX.HASH ! ; : IDX-NUM ( 'idx --- ) ['] CMP-NUM OVER IDX.CMP ! ['] NUM>HASH SWAP IDX.HASH ! ; \ .ridx 21:27 04/26/88 5 5 4 35 WINDOW INFW : .RIDX ( num --- ) >R 18 2 INFW HIL R> 0 <# # # # # # #> SWAP WND-STR! 27 2 INFW HIL WRK.DAT D.NA @ 0 <# # # # # # #> SWAP WND-STR! ; \ add-indexes 13:39 03/14/88 ' NOOP ' NOOP MAX_REC_SZ WRK.DAT " NULL" INDEX WRK.IDX : ADD-INDEX EQU CUR# WRK.DCT D.HU @ 0 ?DO INDICES I + C@ IF FLD.BUFF I WRK.DCT DICT-READ WRK.IDX TYPES FLD.BUFF FLD.TYPE C@ @BIT IF IDX-NUM ELSE IDX-STR THEN FLD.BUFF FLD.OFFSET @ EQU OFFSET FLD.BUFF FLD.LENGTH @ EQU SIZE CUR# .RIDX WRK.IDX I CHG-IDX WRK.IDX 2 FOPEN DROP WRK.IDX WRK.BUFF CUR# IDX-ADD WRK.IDX FCLOSE DROP THEN LOOP ; \ .display 21:40 04/26/88 : .DISPLAY " Reindex" NONE DOUBLE INFW OPEN-WINDOW 2 2 INFW NOR " Indexing item # 00000 of 00000" WND-CSTR! ; \ rbridx 13:26 04/18/88 : RBRIDX " Reindex a file" @ACTIVES ?DUP IF 1- DUP EQU ANCHOR WRK.DCT OVER NAME>DCT WRK.DAT OVER NAME>DAT WRK.DCT HCB>N WRK.IDX NAME>HCB WRK.DCT OPEN-DICTIONARY WRK.DAT OPEN-DICTIONARY MAKE-IDX .DISPLAY -CUR WRK.DAT D.HU @ 0 ?DO WRK.BUFF I WRK.DAT DICT-READ WRK.BUFF ?ACTIVE IF I ADD-INDEX THEN LOOP THEN INFW CLOSE-WINDOW +CUR WRK.DCT CLOSE-DICTIONARY WRK.DAT CLOSE-DICTIONARY ; \ Excises 21:45 04/26/88 EXCISE SIZE OFFSET EXCISE CUR# ANCHOR
