/usr/share/picolisp/lib/conDbgc.l is in picolisp 17.12+20180218-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 | # 24nov16abu
# (c) Software Lab. Alexander Burger
### Concurrent DB Garbage Collector ###
# *DbgcDly *DbgcPid
(default *DbgcDly 64)
(if (fork)
(setq *DbgcPid @)
(wait 60000)
(undef 'upd)
(de upd Lst
(wipe Lst)
(let *DbgcDly (>> 1 *DbgcDly)
(for S Lst
(when (ext? S)
(mark S T)
(markData (val S))
(maps markData S) )
(wipe S) ) ) )
(de markExt (S)
(unless (mark S T)
(wait *DbgcDly)
(markData (val S))
(maps markData S)
(wipe S) ) )
(de markData (X)
(while (pair X)
(markData (++ X)) )
(and (ext? X) (markExt X)) )
(loop
(let MS (+ (/ (usec) 1000) 86400000)
(markExt *DB)
(while (> MS (/ (usec) 1000))
(wait 60000) ) )
(let Cnt 0
(for (F . @) (or *Dbs (2))
(for (S (seq F) S (seq S))
(wait *DbgcDly)
(unless (mark S)
(sync)
(if (mark S)
(tell)
(and (isa '+Entity S) (zap> S))
(zap S)
(commit)
(inc 'Cnt) ) ) ) )
(when *Blob
(use (@S @R F S)
(let Pat (conc (chop *Blob) '(@S "." @R))
(in (list 'find *Blob "-type" "f")
(while (setq F (line))
(wait *DbgcDly)
(when (match Pat F)
(unless
(and
(setq S (extern (pack (replace @S '/))))
(get S (intern (pack @R))) )
(inc 'Cnt)
(call "rm" (pack F)) )
(wipe S) ) ) ) ) ) )
(msg Cnt " conDbgc") )
(mark 0) ) )
# vi:et:ts=3:sw=3
|