program dgptr(output); {digital repeater control program} (*$c-,e-,f-,m-,p-,r-,s+,t-*) const maxinfofld = 128; {maximum info field in a frame} maxinfocnt = 129; {maximum info field count - 1} type tcbptr = ^tcb; {task control block pointer} qcbptr = ^qcb; {queue header pointer} mcbptr = ^mcb; {message control block pointer} frmptr = ^frame; {frame pointer} taskstate = (active,ready,blocked); {task running state} prid = 0..255; {priority and id} tcb = record {task control block} tcblk: tcbptr; {next lower priority tcb} tcbwt: tcbptr; {next waiting tcb} tcbsw: taskstate; {task status word} tcbmd: 0..255; {task mode} tcbrm: mcbptr; {message passed from rcv call} tcbid: prid; {task identity} tcbpr: prid; {task priority: 0=high, 255=low} tcbsb: integer; {bottom of stack} tcbst: integer; {top of stack} tcbhb: integer; {bottom of heap} tcbpc: integer; {task start address} end; qcb = record {queue control block} qcblk: frmptr; {first message in queue} qcbwt: tcbptr; {first waiting tcb in queue} end; mcb = record {message control block} mcblk: frmptr; {next message in queue} mcbtp: 0..255; {message type} mcbvl: 0..255; {message value} end; byte = 0..255; {a byte} code = 0..255; {frame status} addressfield = byte; {address field octet} controlfield = byte; {control field octet} infofield = array[0..maxinfocnt] of byte; {information field length+2} textfield = array[1..70] of char; frame = record {frame control block} lnk: mcb; {linkage to next frame} len: integer; {length of info field} cnt: integer; {current rcv or xmt count} res: 0..7; {residual byte length} adr: addressfield; {frame address} ctl: controlfield; {control field} inf: infofield; {information field} end; lcb = record lineno: 0..31; {physical line in system} baudrate: integer; {system clock divisor baud rate} clockrate: integer; {system clock divisor for 100 ms} timeout: 0..255; {100 ms. clock ticks for T1} a1: array[1..7] of byte; chfree: boolean; {current line state} modemchar: code; {modem characteristics} modemout: byte; {modem output status byte} modemin: byte; {modem input status byte} a2: array[1..19] of byte; rcvstatus: code; {rcv status} rcvmsg: mcb; {rcv message location} rcvframes: qcb; {rcv frames queue} a3: array[1..10] of byte; xmtstatus: code; {xmt status} xmtmsg: mcb; {xmt message location} xmtframes: qcb; {xmt frames queue} a4: array[1..8] of byte; end; var qfree: qcb; {free buffer pool} msg: mcbptr; {incoming message temporary} line: lcb; {line control block} iorun: boolean; {run flag} timecount: integer; {counter for main delay loop} freecount: integer; {counter for channel free condition} fp0,fp1,fp2,fp3: frmptr; {frame pointer temporaries} fp4,fp5,fp6,fp7: frmptr; {frame pointer temporaries} i,j,k: integer; (*$i+*) procedure initio;external; {initialize interrupt system} procedure enable;external; {turn on interrupt system, unfreeze proc. env.} procedure lkopn(var line: lcb);external; {initialize hdlc hardware} procedure lkcls(var line: lcb);external; {deinit hdlc hardware} procedure lkrcv(var line: lcb);external; {start packet receiver} procedure lkxmt(var line: lcb);external; {start packet transmitter} procedure lksts(var line: lcb);external; {line modem status} procedure cwid(var line: lcb);external; {cw identification} procedure delay(time: integer);external; {100 msec delay loop} {This procedure adds a frame to the end of the current list of frames.} procedure enquepkt(var qhdr: qcb; var fp: frmptr); var mp: frmptr; {pointer temporary} empty: boolean; {flag for an empty list} begin fp^.lnk.mcblk := nil; {reset link to next message} mp := qhdr.qcblk; {first message in list} empty := mp = nil; {flag for an empty list} if not empty then {queue has messages already waiting} begin while mp^.lnk.mcblk<>nil do mp := mp^.lnk.mcblk; {find end list} mp^.lnk.mcblk := fp; {put message at end of list} end else {queue is empty} begin qhdr.qcblk := fp {just add a new message} end; end; {This procedure initializes the receive frames and starts the receiver} procedure startrcvr; var fpr: frmptr; {temporary frame pointer} begin line.rcvframes.qcblk := nil; {reset the rcv queue} enquepkt(line.rcvframes,fp0); {enque frame for receiving} enquepkt(line.rcvframes,fp1); {enque frame for receiving} enquepkt(line.rcvframes,fp2); {enque frame for receiving} enquepkt(line.rcvframes,fp3); {enque frame for receiving} enquepkt(line.rcvframes,fp4); {enque frame for receiving} enquepkt(line.rcvframes,fp5); {enque frame for receiving} enquepkt(line.rcvframes,fp6); {enque frame for receiving} enquepkt(line.rcvframes,fp7); {enque frame for receiving} fpr := fp0; {initialize chain} repeat fpr^.lnk.mcbvl := 0; {zero frame status} fpr^.len := 2 + maxinfofld + 2; {set packet length maximum size + crc} fpr := fpr^.lnk.mcblk; {next frame in list} until fpr = nil; {end of list} lkrcv(line); {start the receiver} end; {This procedure initializes a new frame for transmission.} procedure fillpkt(fp: frmptr;adr: addressfield;ctl: controlfield; tfcount: integer;textstr:textfield); var i: integer; begin fp^.len := 4 + tfcount; {total xmt count} fp^.res := 0; {no residual bits} fp^.adr := adr; {initialize address field} fp^.ctl := ctl; {initialize control field} for i := 1 to tfcount do fp^.inf[i-1] := ord(textstr[i]); {move text} fp^.inf[tfcount] := 13; {add carriage return} fp^.inf[tfcount+1] := 10; {add line feed} end; {Send packets out for the beacon} procedure beacon; begin line.xmtframes.qcblk := nil; {reset the xmt queue} fillpkt(fp0,255,0,70, 'This is the KA6M ASCII/HDLC beacon in Menlo Park, California Rev 2.10'); fillpkt(fp1,255,2,69, 'The quick brown fox jumped over the lazy dog''s back. 0123456789 !@#$% '); fillpkt(fp2,255,20,70, 'You are receiving the signal of San Francisco''s first packet repeater.'); enquepkt(line.xmtframes,fp0); {enque frame 0} enquepkt(line.xmtframes,fp1); {enque frame 1} enquepkt(line.xmtframes,fp2); {enque frame 2} lkxmt(line); {transmit the packets} while line.xmtstatus = 0 do ; {wait for end of xmt} end; {Validate and repeat a packet.} procedure retransmit; var fpt: frmptr; {frame being examined} fptnx: frmptr; {next frame in linkage} adr: addressfield; {local storage for address} adrok: boolean; {address in range flag} pst: 0..255; {packet status} pktok: boolean; {packet status acceptable flag} begin line.xmtframes.qcblk := nil; {reinit transmit queue} fpt := fp0; {pointer to first frame in chain} repeat fptnx := fpt^.lnk.mcblk; {get next frame in linkage} adr := fpt^.adr; {get received address} adrok := (adr>=128) and (adr<160); {address in range} pst := fpt^.lnk.mcbvl; {packet status} pktok := (pst=3) or (pst=7); {packet status without errors} if adrok and pktok then {repeat the packet} begin fpt^.len := fpt^.cnt; {set transmit length} fpt^.res := 0; {no residue bits} fpt^.adr := fpt^.adr+32; {use sender's address offset by 32} enquepkt(line.xmtframes,fpt); {place frame onto transmit queue} end; fpt := fptnx; {point to next frame, if any} until fptnx = nil; {stop if end of chain} if line.xmtframes.qcblk <> nil then {if there any good packets} begin lkxmt(line); {transmit them} while line.xmtstatus = 0 do {nothing}; {wait for end of transmit} end; startrcvr; {restart receiver} end; begin {main program} initio; {set up interrupt world} lkopn(line); {initialize the hardware} enable; {turn on interrupt system} new(fp0);new(fp1);new(fp2);new(fp3); {allocate some frames} new(fp4);new(fp5);new(fp6);new(fp7); {allocate some frames} iorun := true; {run forever} while iorun do begin cwid(line); {identify} beacon; {transmit beacon information} startrcvr; {setup and start the receiver} timecount := 3000; {controls delay before next id} freecount := 0; {controls free channel timer} repeat {listen for packets loop} delay(1); {wait 100 milliseconds} lksts(line); {get current modem status} if ((fp0^.lnk.mcbvl<>1) and line.chfree) then retransmit; {repeat pkt} if not line.chfree then freecount := 0 {count up 30 sec of clear chnl} else freecount := freecount + 1; if timecount <> 0 then timecount := timecount - 1; {countdown cwid} until (timecount = 0) and (freecount > 300); end; lkcls(line); {close down the hardware} end.