<*+M2EXTENSIONS *> <*-CHECKDIV *> <*-CHECKRANGE *> <*-COVERFLOW *> <*-IOVERFLOW*> <*-DOREORDER*> <*-PROCINLINE*> <*+GENCTYPES*> <*+COMMENT*> <*+GENCDIV*> <* IF __GEN_C__ THEN *> <*+M2EXTENSIONS *> <*+STORAGE *> <*-GENCTYPES*> <*+COMMENT*> <*-GENHISTORY*> <*-GENDEBUG*> <*-GENDATE*> <*-LINENO*> <*-CHECKINDEX*> <*-CHECKDNDEX*> <*+GENCDIV*> <*-GENKRC*> <*+NOOPTIMIZE*> <*-GENSIZE*> <*-ASSERT*> <*-CHECKNIL*> <*-COVERFLOW*> <*-IOVERFLOW*> <*-CHECKRANGE*> <*-CHECKSET*> <*-CHECKDIV*> <*-GENCONSTENUM*> <*GENWIDTH="120"*> <* ELSE *> <*+GENHISTORY*> <*+GENDEBUG*> <*+LINENO*> <*+CHECKINDEX*> <*+CHECKDINDEX*> <* END *> MODULE pocenc; (* encode pocsag from stdin text to rawbits in udp from https://github.com/faithanalog/pocsag-encoder *) IMPORT udp; FROM SYSTEM IMPORT ADR, CAST, FILL, SHIFT, INT16, CARD16, CARD8, INT8; FROM osi IMPORT Werr, WrStr, WrStrLn, WrInt, WrCard, File, IsFifo, OpenRead, OpenRW, Close, WrBin, WrHex, WrFixed, ALLOCATE, DEALLOCATE, NextArg, RdBin, time, usleep, Rename, openudp, SOCKET, udpsend, timens, OpenWrite; FROM aprsstr IMPORT IntToStr, StrToCard, StrToInt, StrToFix, mon2raw, AppCRC, GetIp2, raw2mon, extrudp2, GHOSTSET, Append, CardToStr, Length, Assign; FROM signal IMPORT signal, SIGTERM, SIGINT, SIGPIPE, sighandler_t; CONST LF=12C; CRCBITS=10; TEXTBITSPERCHAR=7; FLAGMESSAGE=100000H; BATCHSIZE=16; SYNC=7CD215D8H; FRAMESIZE=2; PREAMBLELENGTH=576; IDLE=07A89C197H; FLAGTEXTDATA=3; FLAGNUMERICDATA=0; TEXTBITSPERWORD=20; TYPE SET32=SET OF [0..31]; SET8=SET OF [0..7]; IPNUM=CARDINAL; UDPPORT=CARDINAL; VAR udpip:IPNUM; udpport:UDPPORT; udpfd:INTEGER; func, addr:CARDINAL; inv:BOOLEAN; text:ARRAY[0..39] OF CHAR; PROCEDURE Error(text-:ARRAY OF CHAR); BEGIN Werr(text); Werr(" error abort"+LF); HALT END Error; PROCEDURE StrToHex(s-:ARRAY OF CHAR; VAR n:CARDINAL):BOOLEAN; VAR i:CARDINAL; c:CHAR; BEGIN i:=0; n:=0; WHILE (i<=HIGH(s)) & (s[i]<>0C) DO n:=n*16; c:=CAP(s[i]); IF (c>="0") & (c<="9") THEN INC(n, ORD(c)-ORD("0")) ELSIF (c>="A") & (c<="F") THEN INC(n, ORD(c)-(ORD("A")-10)); ELSE RETURN FALSE END; INC(i); END; RETURN TRUE END StrToHex; PROCEDURE GetIp(h:ARRAY OF CHAR; VAR p:CARDINAL; VAR ip:IPNUM; VAR port:UDPPORT):INTEGER; VAR i, n:CARDINAL; ok:BOOLEAN; BEGIN p:=0; h[HIGH(h)]:=0C; ip:=0; FOR i:=0 TO 4 DO n:=0; ok:=FALSE; WHILE (h[p]>="0") & (h[p]<="9") DO ok:=TRUE; n:=n*10+ORD(h[p])-ORD("0"); INC(p); END; IF NOT ok THEN RETURN -1 END; IF i<3 THEN IF (h[p]<>".") OR (n>255) THEN RETURN -1 END; ip:=ip*256+n; ELSIF i=3 THEN ip:=ip*256+n; IF (h[p]<>":") OR (n>255) THEN RETURN -1 END; ELSIF n>65535 THEN RETURN -1 END; port:=n; INC(p); END; RETURN 0 END GetIp; PROCEDURE Parms; VAR err:BOOLEAN; h,hh:ARRAY[0..4095] OF CHAR; i:CARDINAL; BEGIN LOOP NextArg(h); IF h[0]=0C THEN EXIT END; IF (h[0]="-") & (h[1]<>0C) THEN IF h[1]="h" THEN WrStrLn(""); WrStrLn("encode text on stdin to POCSAG bits sent in UDP, 0 is fsk high freq"); WrStrLn(" -a address RIC 0..2097151 (0)"); WrStrLn(" -f funcion 0..3 (3)"); WrStrLn(" -h this"); WrStrLn(" -i invert fsk"); WrStrLn(" -t if not message text from stdin, use quotes for blanks"); WrStrLn(" -u : send encoded bits to tx"); HALT ELSIF h[1]="u" THEN NextArg(h); IF GetIp(h, i, udpip, udpport)<>0 THEN Error("-u ip:port") END; udpfd:=udp.openudp(); IF udpfd<0 THEN Error("-u cannot open udp") END; ELSIF h[1]="a" THEN NextArg(h); IF NOT StrToCard(h, addr) OR (addr>2097152) THEN Error("-a <=2097151") END; ELSIF h[1]="i" THEN inv:=TRUE; ELSIF h[1]="f" THEN NextArg(h); IF NOT StrToCard(h, func) OR (func>3) THEN Error("-f 0..3") END; ELSIF h[1]="t" THEN NextArg(text); ELSE h[2]:=0C; Append(h, "? use -h"); Error(h) END; h[0]:=0C; ELSE h[1]:=0C; Append(h, "? use -h"); Error(h) END; END; END Parms; (* * Calculate the CRC error checking code for the given word. * Messages use a 10 bit CRC computed from the 21 data bits. * This is calculated through a binary polynomial long division, returning * the remainder. * See https://en.wikipedia.org/wiki/Cyclic_redundancy_check#Computation * for more information. *) PROCEDURE crc(msg:SET32):SET32; CONST CRC_GENERATOR=SET32{0,3,5,6,8,9,10}; VAR denominator, m:SET32; column:CARDINAL; mb:BOOLEAN; BEGIN denominator:=SHIFT(CRC_GENERATOR, 20); --Message is right-padded with zeroes to the message length + crc length m:=SHIFT(msg, CRCBITS); --We iterate until denominator has been right-shifted back to it's original value. FOR column:=0 TO 20 DO --Bit for the column we're aligned to mb:=30 - column IN m; --If the current bit is zero, we don't modify the message this iteration IF mb THEN m:=m/denominator END; denominator:=SHIFT(denominator, -1); END; --At this point 'm' contains the CRC value we've calculated RETURN m*SET32{0..9} END crc; (** * Calculates the even parity bit for a message. * If the number of bits in the message is even, return 0, else return 1. *) PROCEDURE parity(x:SET32):BOOLEAN; VAR p:BOOLEAN; i:CARDINAL; BEGIN p:=FALSE; FOR i:=0 TO 31 DO p:=p<>(i IN x) END; RETURN p END parity; (** * Encodes a 21-bit message by calculating and adding a CRC code and parity bit. *) PROCEDURE encodeCodeword(msg:SET32):CARDINAL; VAR fullCRC:SET32; BEGIN fullCRC:=SHIFT(msg, CRCBITS) + crc(msg); RETURN CAST(CARDINAL, fullCRC)*2+ORD(parity(fullCRC)); END encodeCodeword; (** * ASCII encode a null-terminated string as a series of codewords, written * to *out. Returns the number of codewords written. Caller should ensure * that enough memory is allocated in *out to contain the message * * initial_offset indicates which word in the current batch the function is * beginning at, so that it can insert SYNC words at appropriate locations. *) PROCEDURE encodeASCII(initialoffset:CARDINAL; s-:ARRAY OF CHAR; VAR o:ARRAY OF CARDINAL; VAR out:CARDINAL); VAR i, currentWord, currentNumBits, wordPosition, str:CARDINAL; c:CHAR; BEGIN --Number of words written to *out currentWord:=0; --Nnumber of bits we've written so far to the current word currentNumBits:=0; --Position of current word in the current batch wordPosition:=initialoffset; str:=0; WHILE s[str]<>0C DO c:=s[str]; INC(str); --Encode the character bits backwards FOR i:=0 TO TEXTBITSPERCHAR-1 DO currentWord:=currentWord*2 + ORD(i IN CAST(SET8, c)); INC(currentNumBits); IF currentNumBits=TEXTBITSPERWORD THEN --Add the MESSAGE flag to our current word and encode it. o[out]:=encodeCodeword(CAST(SET32, currentWord) + CAST(SET32, FLAGMESSAGE)); INC(out); currentWord:=0; currentNumBits:=0; INC(wordPosition); IF wordPosition=BATCHSIZE THEN --We've filled a full batch, time to insert a SYNC word --and start a new one. o[out]:=SYNC; INC(out); wordPosition:=0; END; END; END; END; --Write remainder of message IF currentNumBits>0 THEN --Pad out the word to 20 bits with zeroes currentWord:=CAST(CARDINAL, SHIFT(CAST(SET32, currentWord), VAL(INTEGER,20-currentNumBits))); o[out]:=encodeCodeword(CAST(SET32, currentWord) + CAST(SET32, FLAGMESSAGE)); INC(out); INC(wordPosition); IF wordPosition=BATCHSIZE THEN --We've filled a full batch, time to insert a SYNC word --and start a new one. o[out]:=SYNC; INC(out); wordPosition:=0; END; END; RETURN END encodeASCII; (** * An address of 21 bits, but only 18 of those bits are encoded in the address * word itself. The remaining 3 bits are derived from which frame in the batch * is the address word. This calculates the number of words (not frames!) * which must precede the address word so that it is in the right spot. These * words will be filled with the idle value. *) PROCEDURE addressOffset(address:CARDINAL):CARDINAL; BEGIN RETURN (address MOD 8)*FRAMESIZE END addressOffset; (** * Encode a full text POCSAG transmission addressed to (address). * *message is a null terminated C string. * *out is the destination to which the transmission will be written. *) PROCEDURE encodeTransmission(address:CARDINAL; m-:ARRAY OF CHAR; VAR o:ARRAY OF CARDINAL; VAR out:CARDINAL); VAR padding, written, prefixLength, i, start, message:CARDINAL; j:INTEGER; BEGIN --Encode preamble --Alternating 1,0,1,0 bits for 576 bits, used for receiver to synchronize --with transmitter out:=0; message:=0; FOR i:=0 TO PREAMBLELENGTH/32-1 DO o[out]:=0AAAAAAAAH; INC(out); END; start:=out; --Sync o[out]:=SYNC; INC(out); --Write out padding before address word prefixLength:=addressOffset(address); FOR j:=0 TO VAL(INTEGER, prefixLength)-1 DO o[out]:=IDLE; INC(out); END; --Write address word. --The last two bits of word's data contain the message type --The 3 least significant bits are dropped, as those are encoded by the --word's location. o[out]:=encodeCodeword(SHIFT(SHIFT(CAST(SET32, address)*SET32{0..20}, -3), 2) + CAST(SET32, func MOD 4)); INC(out); --Encode the message itself encodeASCII(addressOffset(address) + 1, m, o, out); --Finally, write an IDLE word indicating the end of the message o[out]:=IDLE; INC(out); --Pad out the last batch with IDLE to write multiple of BATCH_SIZE + 1 --words (+ 1 is there because of the SYNC words) written:=out-start; padding:=(BATCHSIZE+1)-written MOD (BATCHSIZE + 1); FOR j:=0 TO VAL(INTEGER, padding)-1 DO o[out]:=IDLE; INC(out); END; END encodeTransmission; VAR bitbuf:ARRAY[0..1500] OF CARDINAL; ubuf:ARRAY[0..1500] OF CHAR; len,j,i,p:CARDINAL; ret:INTEGER; BEGIN addr:=0; text:=""; func:=3; inv:=FALSE; Parms; IF text[0]=0C THEN ret:=RdBin(0, text, SIZE(text)); IF ret<0 THEN Error("missing text") END; IF VAL(CARDINAL, ret)<=HIGH(text) THEN text[ret]:=0C END; END; encodeTransmission(addr, text, bitbuf, len); --WrInt(len,1); WrStrLn("=len"); --bitbuf[22]:=CAST(CARDINAL, CAST(SET32, bitbuf[22])/SET32{27, 24}); FOR i:=0 TO len-1 DO FOR j:=0 TO 31 DO WrInt(ORD(31-j IN CAST(SET32, bitbuf[i])),1) END; WrStrLn(""); END; -- INC(len, 4); IF len>=HIGH(bitbuf) DIV 4 THEN WrInt(len*4,1); WrStrLn("=frame too long "); len:=HIGH(bitbuf) DIV 4; END; FOR i:=0 TO len-1 DO p:=bitbuf[i]; FOR j:=3 TO 0 BY -1 DO IF inv THEN ubuf[i*4+j]:=CHR(p MOD 256) ELSE ubuf[i*4+j]:=CHR(255-p MOD 256) END; p:=p DIV 256; END; END; IF udp.udpsend(udpfd, ubuf, len*4, udpport, udpip)<0 THEN WrStrLn("udp send error") END; END pocenc.