.title CLEAN ;+ ; CLEAN trys to compress KOMs database by remove erased texts ; This, the second version, was created 03-Aug-89 22:58:58 at UFH. ;- .inclu "b:global" APR1 = 1 APR2 = 2 APR3 = 3 APR4 = 4 APR5 = 5 TxtFil = 9. .psect HigTxt: .blkw0 2 MaxTxt: .word 0 NrToEr: .word 0 LsErTx: .blkw0 2 NrAcTx: .word 0 CurTxt: .blkw0 2 FilSiz: .blkw0 6 LinBuf: .blkb 400 CurBl: .word 0 CurPos: .word 0 CurRec: .word 0 CurBl3: .word 0 CntWrd: .word 0 NrLfBl: .word 0 .word 0 FBA: .blkb 1000 .word 0 .word 0 FBB: .blkb 1000 Text TXHDR, <<377><377><1><0>> Text XTHDR, <<377><377><2><0><0><0><0><0><0><0><0><0><0><0><0><0>> Text CnvTxt, <"CLEAN Ver 2.00 "> Text WrngRc, <"Felaktigt TEXTobjekt: Text "> Text WrngFm, <"Felaktigt TEXTformat: Text "> Text WrngEx, <"Felaktigt EXTERNformat: Text "> Text MltRcT, <"Flera mottagare: "> HowMan: .byte 0 .ascii "Max antal aktiva <" EoHwMn: .even .inclu "b:komfil" ; KOM filedefinitions. INIT: .ttnch ; No Echo mov #^RCLE, @#firqb+fqnam1 mov #^RAN , @#firqb+fqnam1+2 .name ; Set work name clr @#Me mov #LinLen-2, @#MaxLin mov #-1, Line clr PTerm ; Default term-typ (dummy crt) clrb @#xrb+xrci .postn mov #Width,r0 clr (r0) ; ? movb @#xrb,(r0) decb (r0) movb @#firqb+fqjob, r0 asr r0 mov r0, @#Job write #CnvTxt ; Write a friendly phrase with version. errprt #0 write #CRLF mov #xSM+xELIN+xBL, @#MyFlags mov #UnProm, @#Stat clr @#KSW movb #UU.SYS,@#Firqb+fqfun clr @#firqb+4 .UUO mov @#firqb+26,@#PPN movb @#Firqb+5,@#TERM OPFIL: mov #EOFS,r2 ; Open files mov #EOFS-Files, r0 ; Number of files * 2 10$: mov #firqb+fqfun, r1 movb #opnfq, (r1)+ mov r0, (r1)+ ; Unit number * 2 mov KOMPPN, (r1)+ mov #^RKOM, (r1)+ mov -(r2), (r1)+ mov #^RDAT, (r1)+ mov #1+8.+128.+32768., firqb+fqmode mov KOMDEV, firqb+fqdev mov KOMDVN, firqb+fqdevn calfip call error mov Firqb+FqSiz, FilSiz-2(r0) ; # of blocks in file. dec r0 sob r0, 10$ write #CRLF ; Attach to KOM overlay library. call clrfqb movb #ATRFQ, Firqb+fqfil mov KOMLIB, Firqb+12 mov KOMLIB+2, Firqb+14 mov #1, Firqb+22 ; Read Only. .plas ; Attach Resedent Library call Error mov Firqb+Fqppn, OLIde ; mov Firqb+Fqnam1, OLSiz call clrfqb movb #CRAFQ, Firqb+Fqfil movb #APR3, Firqb+7 mov #Firqb+12,r1 mov #128., (r1)+ mov OLIde, (r1)+ mov OvlTbl+SegB, (r1)+ mov OvlTbl+SegB+2, (r1)+ mov #200,(r1) ; ReadOnly, Mapping. .plas call Error mov firqb+fqppn, OWIde ; Window ID mov #SegB, curseg ; Current maped segment. ; Attach to KOM group-and command library. call clrfqb movb #ATRFQ, Firqb+fqfil mov KOMRES, Firqb+12 mov KOMRES+2, Firqb+14 mov #2, Firqb+22 .plas ; Attach Resedent Library call Error mov Firqb+Fqppn, LibIde mov Firqb+Fqnam1, LibSiz call clrfqb movb #CRAFQ, Firqb+Fqfil movb #APR4, Firqb+7 mov #Firqb+12,r1 ; There WAS a bug here! mov #128., (r1)+ mov LibIde, (r1)+ clr (r1)+ clr (r1)+ mov #202, (r1) ; Write access and Mapping .plas call Error mov firqb+fqppn, WinIde ; Window ID clr CurSek ; Current maped sektion. mov #100, ResLim bis #UseRes, KSW ; Now we uses a RESLIB ; for our commands. mov #2,r2 gos Get, <#1, r2, #FB1, #1, #Lock> ; Get INFO-block cmp #50., FB1+32 ; Right DATABASE Version beq 20$ iot 20$: mov FB1+14, MaxTxt mov FB1+22, HigTxt mov FB1+24, HigTxt+2 mov FB1+26, NrToEr mov FB1+110, HshSiz ; # of entrys in hash-table. mov FB1+112, HshEnd gos put, <#1,, #Fb1> mov #stack, sp mov #ovlstk, ovlsp ; 1'st: Ask how many active texts that are to be preserved. Ask: mov #AIRFOP, stat mov #EoHwMn, r2 mov MaxTxt, r1 call Num16 10$: movb (r1)+, (r2)+ sob r0, 10$ movb #'>, (r2)+ sub #HowMan+1, r2 movb r2, HowMan PARSER #HetLst, #-1, #HowMan call pcr2lf tst level beq Rename clr r0 call GVal mov r0, MaxTxt bne Rename iot ; 2'nd: Rename KOM3.DAT to KOM3.OLD Rename: call pcrlf mov MaxTxt, r1 clr r0 gos deco16 call pcr2lf call $exit iot call clrfqb ; Rename KOM3.DAT to KOM3.OLD movb #RENFQ, Firqb+fqfun mov #firqb+fqppn, r1 clr (r1)+ mov #^RKOM, (r1)+ mov File3, (r1)+ mov #^RDAT, (r1)+ clr (r1)+ mov #^RKOM, (r1)+ mov File3, (r1)+ mov #^ROLD, (r1)+ mov KOMDEV, firqb+fqdev mov KOMDVN, firqb+fqdevn calfip call error ; 3'd: Create a new text file (KOM3.DAT). NewFil: call clrfqb movb #CREFQ, firqb+fqfun movb #TxtFil*2, firqb+fqfil mov #firqb+fqnam1, r1 mov #^RKOM, (r1)+ mov File3, (r1)+ mov #^RDAT, (r1)+ mov #firqb+fqdev, r1 mov KOMDEV, (r1)+ mov KOMDVN, (r1)+ mov #200, Firqb+FqClus calfip call Error ; 4'th: Reset all Hash-Entrys in file 5. ErasHs: mov HshEnd, r4 beq DoCnv mov #400, r0 mov #FBB+1000, r3 10$: clr -(r3) sob r0, 10$ mov #2, r5 100$: gos Put, <#5, r5, r3> inc r5 sob r4, 100$ ; Finaly: Get started! Build a new text file with all active texts ; and make our hash list. DoCnv: clr FB1-2 ; Buffert for file 2 clr FB2-2 ; file 2 clr FB3-2 ; file 3 clr FB4-2 ; file TxtFil clr FBA-2 ; Not Used (yet) clr CurTxt clr CurTxt+2 clr NrAcTx ; # of active texts-saved. sub MaxTxt, NrToEr ; # of texts that are doomed! mov #2, CurBl mov #Fb4, CurPos mov #499., CntWrd 10$: mov #400, NrLfBl mov #FBB, r3 get <#5, r5, r3, #1,> 20$: inc CurTxt adc CurTxt+2 cmp CurTxt+2, HigTxt+2 bhi 999$ blo 40$ cmp CurTxt, HigTxt bhi 999$ 40$: mov (r3)+, r2 beq 600$ dec CntWrd bne 50$ mov #CurTxt, r1 call deco32 call pcrlf mov #499., CntWrd 50$: gos GetRec, <#2, r2, #Fb1,> mov r1, r4 cmp #1, (r1) beq 60$ gos SgnErr, <#WrngRc> 60$: tst NrToEr ; Are we still eraseing texts? bne 200$ ; No, goto 20$ bit #10, 14(r4) bne 200$ ; This one are not to be removed. dec NrToEr ; One more is gone... mov CurTxt, LsErTx mov CurTxt+2, LsErTx+2 clr -2(r3) mov r2, r0 mov r4, r1 call UnCom gos Dispos, <#2, r2, #Fb1> br 600$ 200$: gos MovTxt ; Move text to the new KOM3.DAT gos MovExt ; Move external-text and change ; pointer/date-format. gos Put, <#2,, #Fb1> 600$: dec NrLfBl bne 20$ br 10$ 999$: gos put, <#TxtFil, CurBl, #Fb4> call clrfqb movb #RSTFQ, Firqb+FqFun movb #TblFil*2, Firqb+FqFil calfip ; get rid of KOMTBL.TMP jmp eop Proc SgnErr, begin push Write ErrMsg(r5) mov #CurTxt, r1 clr r0 call deco32 call pcrlf pop ret Proc MovTxt var nr, word var Blk, word var Pos, word begin push mov 20(r4), Blk(r5) mov 22(r4), Pos(r5) gos OpnTxt, call GtWrdX cmp #-2, r0 bne 60$ ; Ok, this text are already saved. Just get block, and position. call GtWrd call GtWrd mov r0, 20(r4) ; Block. call GtWrd mov r0, 22(r4) ; Position. br 999$ 60$: mov #-2, r0 call PtWrdX call GtWrdX cmp #-1, r0 beq 80$ ; Illigal TEXT-format. Abort with error... 70$: gos SgnErr, <#WrngFm> clr 20(r4) clr 22(r4) clr r0 call PtWrdX call PtWrdX br 999$ ; New text: save it and 80$: call EvnTxt mov CurBl, 20(r4) mov CurPos, 22(r4) sub #Fb4, 22(r4) mov CurBl, r0 call PtWrdX call GtWrdX mov r0, nr(r5) mov CurPos, r0 call PtWrdX call SaveX mov #TXHdr, r1 movb (r1)+, r2 90$: movb (r1)+, r0 call PtChr sob r2, 90$ mov nr(r5), r0 call PtWrd tst r0 beq 999$ 100$: call GtChr call PtChr mov r0, r2 beq 120$ 110$: call GtChr call PtChr sob r2, 110$ 120$: dec nr(r5) bne 100$ 200$: 999$: pop ret Proc MovExt var nr, word var count, word var HashNr, word var Blk, word var Pos, word begin push mov 20(r4), Blk(r5) mov 22(r4), Pos(r5) gos OpnTxt, call GtWrdX cmp #-2, r0 bne 60$ ; Ok, this text are already saved. Just get block, and position. call GtWrd ; Mark last word as read. call GtWrd ; Read next word. mov r0, 20(r4) ; Block. call GtWrd mov r0, 22(r4) ; Position. br 999$ 60$: mov #-2, r0 call PtWrdX call GtWrdX cmp #-1, r0 beq 80$ ; Illigal TEXT-format. Abort with error... 70$: gos SgnErr, <#WrngFm> clr 20(r4) clr 22(r4) clr r0 call PtWrdX call PtWrdX br 999$ ; New text: save it and references to new text in the old textfile... 80$: call EvnTxt mov CurBl, 20(r4) mov CurPos, 22(r4) sub #Fb4, 22(r4) mov CurBl, r0 call PtWrdX call GtWrdX mov r0, nr(r5) mov CurPos, r0 call PtWrdX call SaveX mov CurBl, 40(r4) mov CurPos, 42(r4) sub #Fb4, 42(r4) mov #XTHdr, r1 movb (r1)+, r2 70$: movb (r1)+, r0 call PtChr sob r2, 70$ gos OpnTxt, call GtWrd dec r0 call PtWrd mov r0, nr(r5) call GtWrd ; Status line call GtWrd mov r0, 6(r4) call GtWrd mov r0, 10(r4) call GtWrd tst nr(r5) beq 200$ 100$: call GtChr call Ptchr mov r0, count(r5) beq 200$ mov #LinBuf, r2 140$: call GtChr call PtChr movb r0, (r2)+ dec count(r5) bne 140$ mov #LinBuf, r1 cmpb #'F, (r1)+ bne 200$ mov r2, r0 sub r1, r0 beq 200$ mov #TmpStr, r2 call GetIdS bcs 150$ call HashIt br 170$ 150$: clr r0 170$: mov r0, HashNr(r5) 200$: dec nr(r5) bne 100$ 400$: bit #xEXIN, 14(r4) beq 999$ mov HashNr(r5), r0 beq 999$ gos InToHs, 999$: pop ret Proc OpnTxt, begin mov #Fb3, r3 gos Get, <#3, Blk(r5), r3, #1,> add Pos(r5), r3 mov Blk(r5), CurBl3 ret GtChr: clr r0 bisb (r3)+, r0 cmp #Fb3+1000, r3 bhi 10$ mov #Fb3, r3 inc CurBl3 gos Get, <#3, CurBl3, r3, #1,> ; Get next block 10$: rts pc PtChr: push r1 mov CurPos, r1 movb r0, (r1)+ cmp #Fb4+1000, r1 bhi 10$ mov #Fb4, r1 gos Put, <#TxtFil, CurBl, r1> inc CurBl 10$: mov r1, CurPos pop r1 rts pc GtWrd: mov (r3)+, r0 cmp #Fb3+1000, r3 bhi 10$ mov #Fb3, r3 inc CurBl3 gos Get, <#3, CurBl3, r3, #1,> ; Get next block 10$: rts pc GtWrdX: mov (r3), r0 rts pc PtWrdX: mov r0, (r3)+ cmp #Fb3+1000, r3 bhi 10$ mov #Fb3, r3 gos Put, <#3, CurBl3, r3> inc CurBl3 gos Get, <#3, CurBl3, r3, #1,> ; Get next block 10$: rts pc SaveX: cmp #Fb3, r3 beq 10$ gos Put, <#3, CurBl3, #Fb3> 10$: jmp GtWrd EvnTxt: push r0 bit #1, CurPos beq 10$ clr r0 call PtChr 10$: pop r0 rts pc PtWrd: push r1 mov CurPos, r1 mov r0, (r1)+ cmp #Fb4+1000, r1 bhi 10$ mov #Fb4, r1 gos Put, <#TxtFil, CurBl, r1> inc CurBl 10$: mov r1, CurPos pop r1 rts pc proc InToHs begin push gos put, <#TxtFil, CurBl, #Fb4> mov HashNr(r5), r1 clr r0 div #200, r0 add #2, r0 ; Block Number! (2 = first block) asl r1 asl r1 ; Address in block gos Get, <#5, r0, #FBB, #1,> add #FBB, r1 mov (r1), r2 ; Block mov ExtBlk(r5), (r1)+ mov (r1), r3 ; Position mov ExtPos(r5), (r1) gos Put, <#5,,#FBB> tst r3 beq 100$ bpt mov #FB4, r4 gos Get, <#TxtFil, r2, r4, #1,> mov r3, r1 add r4, r1 gos GtWrd2 <#FB4> cmp #-1, r0 beq 50$ 40$: clr r2 ; Cut of pointer to sick EXTERN. clr r3 br 100$ 50$: gos GtWrd2 <#FB4> cmp #2, r0 bne 40$ gos GtWrd2 <#FB4> gos GtWrd2 <#FB4> mov r1, r4 mov ExtBlk(r5), r0 call PutWrd mov ExtPos(r5), r0 call PutWrd gos Put <#TxtFil,, #FB4> 100$: mov #FB4, r4 gos Get, <#TxtFil, ExtBlk(r5), r4, #1,> add ExtPos(r5), r4 mov #-1, r0 call PutWrd mov #2, r0 call PutWrd mov r2, r0 call PutWrd mov r3, r0 call PutWrd clr r0 call PutWrd call PutWrd mov CurTxt, r0 call PutWrd mov CurTxt+2, r0 call PutWrd gos Put, <#TxtFil,, #FB4> gos get, <#TxtFil, CurBl, #FB4, #1,> pop ret PutWrd: mov r0, (r4)+ cmp r4, #FB4+1000 blo 100$ gos put, <#TxtFil, ,#FB4> push r0 mov #FB4-2, r4 mov (r4)+, r0 inc r0 gos Get, <#TxtFil ,r0 ,r4 , #1,> pop r0 100$: rts pc Proc GtWrd2, begin push r2 mov buf(r5), r2 add #1000, r2 cmp r1, r2 blo 50$ mov buf(r5), r1 gos Get, <#TxtFil,,r1,#1,> ; Get next block. 50$: mov (r1)+, r0 pop r2 ret eop: jmp $exit EOKOM: .End INIT