Commit 6ddad5eb authored by Christoph Cullmann's avatar Christoph Cullmann

more cleanups

parent 9b03a2da
......@@ -21,7 +21,3 @@ Kate & KWrite manuals
## autotests
Automated unit tests
## examples
Examples for syntax highlighting and co
This diff is collapsed.
;
; Decodeur de trame pulsadis EJP et préavis EJP
; (pic 12C508 ou 509)
; Alain Gibaud, 20-2-2001
;
; ========================================================
list r=hex,p=p12c508
include "p12c508.inc"
GP0 equ 0
GP1 equ 1
GP2 equ 2
GP3 equ 3
GP4 equ 4
GP5 equ 5
TO equ 4
; masques pour acceder aux pattes
GP0bit equ 1 << GP0
GP1bit equ 1 << GP1
GP2bit equ 1 << GP2
GP3bit equ 1 << GP3
GP4bit equ 1 << GP4
GP5bit equ 1 << GP5
; ========================================================
; affectation des pattes
;
; sorties: (actives niv bas)
NORMAL equ GP0 ; LED verte
ALERTE equ GP1 ; LED orange
EJP equ GP2 ; LED rouge
; entrees:( actives niv bas)
SIGNAL equ GP3 ; avec pull-up, en provenance filtre 175 Hz
; GP4-5 sont utilisees par l'horloge
; ========================================================
; variables:
TICKS equ 0x7 ; compteur de ticks (1 tick = 2/100 s)
SLOT equ 0x8 ; numero slot dans la trame
; =======================================================
; Macros pour alleger le code ...
;
; Teste si min <= (var) < max
; branche en "in" si oui, en "out" si non.
;
Lminmax macro var,min,max,outm,in,outp
movlw min
subwf var,W ; (var) - min
btfss STATUS,C
goto outm ; C=0 => resutat < 0 => var < min
movlw max
subwf var,W ; (var) - max
btfss STATUS,C
goto in
goto outp ; C=1 => resutat >= 0 => var >= min
endm
;
; Attend que le bit "bit" du registre "reg" soit a 1
;
Waitbit1 macro reg,bit
local Wait1
Wait1 btfss reg,bit
goto Wait1
endm
;
; Attend que le bit "bit" du registre "reg" soit a 0
;
Waitbit0 macro reg,bit
local Wait0
Wait0 btfsc reg,bit
goto Wait0
endm
;
; Branche en "label" si (reg) == num, sinon continue
;
Beq macro label,reg,num
movlw num
subwf reg,W
btfsc STATUS,Z
goto label
endm
;
; Branche en "label" si (reg) != num, sinon continue
;
Bne macro label,reg,num
movlw num
subwf reg,W
btfss STATUS,Z
goto label
endm
;
; Branche en "label" si (reg) < num, sinon continue
;
Blt macro label,reg,num
movlw num
subwf reg,W ; reg - W
btfss STATUS,C
goto label ; C=0 => reg - W < 0
endm
;
; Branche en "label" si (reg) >= num, sinon continue
;
Bge macro label,reg,num
movlw num
subwf reg,W ; reg - W
btfsc STATUS,C
goto label ; C=1 => reg - W >= 0
endm
; ========================================================
; CONFIG word ( en FFF )
; bits 11:5 don't care
; bit 4 : MCLRE enabled = 1, tied to Vdd = 0
; bit 3 : code protection off = 1, on = 0
; bit 2 : no watchdog = 0, watchdog = 1
; bit 1-0 ; EXTRC = 00, INTRC = 10, XT = 01, LP = 00
__CONFIG B'000000001101' ; (horloge a quartz, avec watchdog)
; ========================================================
org 0
goto debut
;=========================================================
; sous-programmes
; ========================================================
; regarde si le timer est passe a 0
; si oui, le compteur de ticks est incremente
; et on attend le repassage a 1
; Cette routine DOIT etre appelee tout les 2/100 s ou plus souvent
tickcount
clrwdt
movf TMR0,W
btfss STATUS,Z
retlw 0
incf TICKS,F
; attendre que le timer ait depasse 0
waitnoZ
clrwdt
movf TMR0,W
btfsc STATUS,Z
goto waitnoZ
retlw 0
;
; les 2 fct qui suivent maintiennent, le compteur de ticks
; (en plus de scruter une patte)
; attente d'un signal (logique negative)
waitsignal
call tickcount
btfsc GPIO,SIGNAL
goto waitsignal
retlw 0
; attente fin signal
waitnosignal
call tickcount
btfss GPIO,SIGNAL
goto waitnosignal
retlw 0
; remet a zero le compteur de ticks et le timer et le watchdog
clearticks
clrwdt
clrw
movwf TICKS
movwf TMR0
; pour eviter un timeout immediat, le timer est charge
; a 1, et le 1er tick ne fait que 0.019922s au lieu de 0.2s
; (ce n'est pas grave dans la mesure ou de toute facon,
; le temps de traitement entre les different declenchements
; de chrono n'est pas nul)
incf TMR0,F
retlw 0
;
; ==========================================================
;
debut
; reset par Watchdog ?
btfsc STATUS,TO
goto notimeout
; TO == 0 : OUI
clrwdt
goto 0x1FF ; recalibrage, 0x3FF sur 12C509
; TO == 1 : NON
notimeout
movwf OSCCAL ; recalibrer l'horloge
clrf TMR0 ; RAZ timer
; GPWU=1 : disable wake up on pin change
; GPPU=0 : enable pullups (a voir avec le hard ..)
; T0CS=0 : timer connected to F/4
; T0SE=x : dont't care
; PSA=0 : prescaler assigned to timer
; PS2-0= : timer prescaler 111= 1/256, 101 = 1/64, 011 = 1/16
movlw B'10010101'
option
; config des pattes
movlw B'00001000' ; GP0-2 en sortie, GP3 entree
tris GPIO
; se mettre en mode normal
bcf GPIO,NORMAL
bsf GPIO,ALERTE
bsf GPIO,EJP
attendre_trame
call waitnosignal ; attendre ...
call waitsignal ; ... front montant
call clearticks
call waitnosignal
; 45 tk = 0.9s, 55 tk = 1.1s
Lminmax TICKS,D'45',D'55',attendre_trame,pulse1s,attendre_trame
pulse1s
; attendre 162,5 tk = 2.75 s + 0.5 s = 3.25 s
call clearticks
again325
call tickcount
Lminmax TICKS,D'162',D'162',again325,again325,end325
end325
; on est maintenant au centre du 1er bit
; il suffit d'echantillonner toutes les 2.5s
movlw 1
movwf SLOT
sample btfsc GPIO,SIGNAL ; logique negative
goto slot40
; signal detecte !!
Bne not5,SLOT,D'5' ; slot == 5 ?
; oui - 5 = passage en alerte
bsf GPIO,NORMAL ; bit a 1 = LED eteinte
bsf GPIO,EJP ; bit a 1 = LED eteinte
bcf GPIO,ALERTE ; bit a 0 = LED allumee
goto nextslot
not5
Bne not15,SLOT,D'15' ; slot == 15 ?
; oui
btfsc GPIO,ALERTE ; deja en alerte ?
goto endejp
; oui - 5 & 15 = debut ejp
bsf GPIO,NORMAL ; bit a 1 = LED eteinte
bsf GPIO,ALERTE ; bit a 1 = LED eteinte
bcf GPIO,EJP ; bit a 0 = LED allumee
goto nextslot
endejp
; non - 15 seul = fin ejp
bsf GPIO,EJP ; bit a 1 = LED eteinte
bsf GPIO,ALERTE ; bit a 1 = LED eteinte
bcf GPIO,NORMAL ; bit a 0 = LED allumee
goto nextslot
not15
slot40
; slot 40 ?
Bne nextslot,SLOT,D'40' ; slot == 40 ?
; et attendre une nouvelle trame
goto attendre_trame
nextslot
incf SLOT,F
; si le signal est a 1, on en profite pour se resynchroniser
; sur son front descendant, au cas ou l'emetteur ne soit pas
; bien conforme au protocole.
btfss GPIO,SIGNAL
goto resynchro
; attendre 125 ticks = 2.5s
call clearticks
again125
call tickcount
Lminmax TICKS,D'125',D'126',again125,sample,again125
resynchro
call waitnosignal
call clearticks
again100 ; attente 2 s (100 ticks)
call tickcount
Lminmax TICKS,D'100',D'101',again100,sample,again100
end
(
Example File for ANS Forth Syntax Highlighting
6th December 2011 Mark Corbin <mark@dibsco.co.uk>
Version 1.0 06-12-11
- Initial release.
)
\ This is a single line comment.
( This
is
a
multi-line
comment )
\ Single Characters
char A
[char] B
\ Strings
." Display this string."
s" Compile this string."
abort" This is an error message."
word parsethisstring
c" Compile another string."
parse parsethisstringtoo
.( Display this string too.)
\ Constants and Variables
variable myvar
2variable mydoublevar
constant myconst
2constant mydoubleconst
value myval
20 to myval
fvariable myfloatvar
fconstant myfloatconst
locals| a b c d|
\ Single Numbers
123
-123
\ Double Numbers
123.
12.3
-123.
-12.3
\ Floating Point Numbers
1.2e3
-1.2e3
12e-3
+12e-3
-12e-3
+12e+3
\ Keywords (one from each list)
dup
roll
flush
scr
dnegate
2rot
catch
abort
at-xy
time&date
file-size
rename-file
fround
fsincos
(local)
locals| |
allocate
words
assembler
search-wordlist
order
/string
\ Obsolete Keywords (one from each list)
tib
forget
\ Simple Word Definition
: square ( n1 -- n2 )
dup \ Duplicate n1 on top of stack.
* \ Multiply values together leaving result n2.
;
\ Words that Define New Words or Reference Existing Words
create newword
marker newmarker
[compile] existingword
see existingword
code newcodeword
forget existingword
\ Loop Constructs
: squares ( -- )
10 0 do
i
dup
*
.
loop
;
: forever ( -- )
begin
." This is an infinite loop."
again
;
variable counter
0 counter !
: countdown ( -- )
begin
counter @ \ Fetch counter
dup . \ Display count value
1- dup counter ! \ Decrement counter
0= \ Loop until counter = 0
until
;
: countup ( -- )
begin
counter @ \ Fetch counter
dup . \ Display count value
10
<
while
1 counter +! \ Increment counter if < 10
repeat
;
\ Conditional Constructs
: testnegative ( n -- )
0< if
." Number is negative"
then
;
variable flag
0 flag !
: toggleflag ( -- )
flag @ if \ Fetch flag and test
." Flag is true."
0 flag ! \ Set flag to false
else
." Flag is false."
1 flag ! \ Set flag to true
then
;
: translatenumber ( n -- )
case
1 of
." Eins"
endof
2 of
." Zwei"
endof
3 of
." Drei"
endof
." Please choose a number between 1 and 3."
endcase
;
\ END OF FILE
all.equal <- function(target, current, ...) UseMethod("all.equal")
all.equal.default <-
function(target, current, check.attributes = TRUE, ...)
{
## Really a dispatcher given mode() of args :
## use data.class as unlike class it does not give "Integer"
if(is.language(target) || is.function(target) || is.environment(target))
return(all.equal.language(target, current, ...))
if(is.recursive(target))
return(all.equal.list(target, current, ...))
msg <- c(if(check.attributes) attr.all.equal(target, current, ...),
if(is.numeric(target)) {
all.equal.numeric(target, current, check.attributes = check.attributes, ...)
} else
switch (mode(target),
logical = ,
complex = ,
numeric = all.equal.numeric(target, current, check.attributes = check.attributes, ...),
character = all.equal.character(target, current, check.attributes = check.attributes, ...),
if(data.class(target) != data.class(current)) {
paste("target is ", data.class(target), ", current is ",
data.class(current), sep = "")
} else NULL))
if(is.null(msg)) TRUE else msg
}
all.equal.numeric <-
function(target, current, tolerance = .Machine$double.eps ^ .5,
scale = NULL, check.attributes = TRUE, ...)
{
msg <- if(check.attributes) attr.all.equal(target, current, ...)
if(data.class(target) != data.class(current)) {
msg <- c(msg, paste("target is ", data.class(target), ", current is ",
data.class(current), sep = ""))
return(msg)
}
lt <- length(target)
lc <- length(current)
cplx <- is.complex(target)
if(lt != lc) {
## *replace* the 'Lengths' msg[] from attr.all.equal():
if(!is.null(msg)) msg <- msg[- grep("\\bLengths\\b", msg)]
msg <- c(msg, paste(if(cplx)"Complex" else "Numeric",
": lengths (", lt, ", ", lc, ") differ", sep = ""))
return(msg)
}
target <- as.vector(target)
current <- as.vector(current)
out <- is.na(target)
if(any(out != is.na(current))) {
msg <- c(msg, paste("'is.NA' value mismatches:", sum(is.na(current)),
"in current,", sum(out), " in target"))
return(msg)
}
out <- out | target == current
if(all(out)) { if (is.null(msg)) return(TRUE) else return(msg) }
target <- target[!out]
current <- current[!out]
if(is.integer(target) && is.integer(current)) target <- as.double(target)
xy <- mean((if(cplx)Mod else abs)(target - current))
what <-
if(is.null(scale)) {
xn <- mean(abs(target))
if(is.finite(xn) && xn > tolerance) {
xy <- xy/xn
"relative"
} else "absolute"
} else {
xy <- xy/scale
"scaled"
}
if(is.na(xy) || xy > tolerance)
msg <- c(msg, paste("Mean", what, if(cplx)"Mod", "difference:", format(xy)))
if(is.null(msg)) TRUE else msg
}
all.equal.character <-
function(target, current, check.attributes = TRUE, ...)
{
msg <- if(check.attributes) attr.all.equal(target, current, ...)
if(data.class(target) != data.class(current)) {
msg <- c(msg, paste("target is ", data.class(target), ", current is ",
data.class(current), sep = ""))
return(msg)
}
lt <- length(target)
lc <- length(current)
if(lt != lc) {
if(!is.null(msg)) msg <- msg[- grep("\\bLengths\\b", msg)]
msg <- c(msg, paste("Lengths (", lt, ", ", lc,
") differ (string compare on first ", ll <- min(lt, lc),
")", sep = ""))
ll <- seq(length = ll)
target <- target[ll]
current <- current[ll]
}
nas <- is.na(target)
if (any(nas != is.na(current))) {
msg <- c(msg, paste("'is.NA' value mismatches:", sum(is.na(current)),
"in current,", sum(nas), " in target"))
return(msg)
}
ne <- !nas & (target != current)
if(!any(ne) && is.null(msg)) TRUE
else if(any(ne)) c(msg, paste(sum(ne), "string mismatches"))
else msg
}
all.equal.factor <- function(target, current, check.attributes = TRUE, ...)
{
if(!inherits(current, "factor"))
return("'current' is not a factor")
msg <- if(check.attributes) attr.all.equal(target, current)
class(target) <- class(current) <- NULL
nax <- is.na(target)
nay <- is.na(current)
if(n <- sum(nax != nay))
msg <- c(msg, paste("NA mismatches:", n))
else {
target <- levels(target)[target[!nax]]
current <- levels(current)[current[!nay]]
if(is.character(n <- all.equal(target, current, check.attributes = check.attributes)))
msg <- c(msg, n)
}
if(is.null(msg)) TRUE else msg
}
all.equal.formula <- function(target, current, ...)
{
if(length(target) != length(current))
return(paste("target, current differ in having response: ",
length(target) == 3, ", ", length(current) == 3))
if(all(deparse(target) != deparse(current)))
"formulas differ in contents"
else TRUE
}
all.equal.language <- function(target, current, check.attributes = TRUE, ...)
{
mt <- mode(target)
mc <- mode(current)
if(mt == "expression" && mc == "expression")
return(all.equal.list(target, current, check.attributes = check.attributes, ...))
ttxt <- paste(deparse(target), collapse = "\n")
ctxt <- paste(deparse(current), collapse = "\n")
msg <- c(if(mt != mc)
paste("Modes of target, current: ", mt, ", ", mc, sep = ""),
if(ttxt != ctxt) {
if(pmatch(ttxt, ctxt, FALSE))
"target a subset of current"
else if(pmatch(ctxt, ttxt, FALSE))
"current a subset of target"
else "target, current don't match when deparsed"
})
if(is.null(msg)) TRUE else msg
}
all.equal.list <- function(target, current, check.attributes = TRUE, ...)
{
msg <- if(check.attributes) attr.all.equal(target, current, ...)
## nt <- names(target)
## nc <- names(current)
iseq <-
## <FIXME>
## Commenting this eliminates PR#674, and assumes that lists are
## regarded as generic vectors, so that they are equal iff they
## have identical names attributes and all components are equal.
## if(length(nt) && length(nc)) {
## if(any(not.in <- (c.in.t <- match(nc, nt, 0)) == 0))
## msg <- c(msg, paste("Components not in target:",
## paste(nc[not.in], collapse = ", ")))
## if(any(not.in <- match(nt, nc, 0) == 0))
## msg <- c(msg, paste("Components not in current:",
## paste(nt[not.in], collapse = ", ")))
## nt[c.in.t]
## } else
## </FIXME>
if(length(target) == length(current)) {
seq(along = target)
} else {
if(!is.null(msg)) msg <- msg[- grep("\\bLengths\\b", msg)]
nc <- min(length(target), length(current))
msg <- c(msg, paste("Length mismatch: comparison on first",
nc, "components"))
seq(length = nc)
}
for(i in iseq) {
mi <- all.equal(target[[i]], current[[i]], check.attributes = check.attributes, ...)
if(is.character(mi))
msg <- c(msg, paste("Component ", i, ": ", mi, sep=""))
}
if(is.null(msg)) TRUE else msg
}
attr.all.equal <- function(target, current,
check.attributes = TRUE, check.names = TRUE, ...)
{
##--- "all.equal(.)" for attributes ---
##--- Auxiliary in all.equal(.) methods --- return NULL or character()
msg <- NULL
if(mode(target) != mode(current))
msg <- paste("Modes: ", mode(target), ", ", mode(current), sep = "")
if(length(target) != length(current))
msg <- c(msg, paste("Lengths: ", length(target), ", ",
length(current), sep = ""))
ax <- attributes(target)
ay <- attributes(current)
if(check.names) {
nx <- names(target)
ny <- names(current)
if((lx <- length(nx)) | (ly <- length(ny))) {
## names() treated now; hence NOT with attributes()
ax$names <- ay$names <- NULL
if(lx && ly) {
if(is.character(m <- all.equal.character(nx, ny, check.attributes = check.attributes)))
msg <- c(msg, paste("Names:", m))
} else if(lx)
msg <- c(msg, "names for target but not for current")