home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols100 / vol143 / dgptr.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-07-13  |  11.1 KB  |  254 lines
  1. program dgptr(output);  {digital repeater control program}
  2.  
  3. (*$c-,e-,f-,m-,p-,r-,s+,t-*)
  4.  
  5. const   maxinfofld = 128;       {maximum info field in a frame}
  6.         maxinfocnt = 129;       {maximum info field count - 1}
  7.  
  8. type    tcbptr = ^tcb;          {task control block pointer}
  9.         qcbptr = ^qcb;          {queue header pointer}
  10.         mcbptr = ^mcb;          {message control block pointer}
  11.         frmptr = ^frame;        {frame pointer}
  12.         taskstate = (active,ready,blocked);     {task running state}
  13.         prid = 0..255;          {priority and id}
  14.  
  15.         tcb = record            {task control block}
  16.           tcblk: tcbptr;        {next lower priority tcb}
  17.           tcbwt: tcbptr;        {next waiting tcb}
  18.           tcbsw: taskstate;     {task status word}
  19.           tcbmd: 0..255;        {task mode}
  20.           tcbrm: mcbptr;        {message passed from rcv call}
  21.           tcbid: prid;          {task identity}
  22.           tcbpr: prid;          {task priority: 0=high, 255=low}
  23.           tcbsb: integer;       {bottom of stack}
  24.           tcbst: integer;       {top    of stack}
  25.           tcbhb: integer;       {bottom of heap}
  26.           tcbpc: integer;       {task start address}
  27.         end;
  28.  
  29.         qcb = record            {queue control block}
  30.           qcblk: frmptr;        {first message in queue}
  31.           qcbwt: tcbptr;        {first waiting tcb in queue}
  32.         end;
  33.  
  34.         mcb = record            {message control block}
  35.           mcblk: frmptr;        {next message in queue}
  36.           mcbtp: 0..255;        {message type}
  37.           mcbvl: 0..255;        {message value}
  38.         end;
  39.  
  40.         byte = 0..255;          {a byte}
  41.         code = 0..255;          {frame status}
  42.         addressfield = byte;    {address field octet}
  43.         controlfield = byte;     {control field octet}
  44.         infofield = array[0..maxinfocnt] of byte; {information field length+2}
  45.         textfield = array[1..70] of char;
  46.  
  47.         frame = record          {frame control block}
  48.           lnk: mcb;             {linkage to next frame}
  49.           len: integer;         {length of info field}
  50.           cnt: integer;         {current rcv or xmt count}
  51.           res: 0..7;            {residual byte length}
  52.           adr: addressfield;    {frame address}
  53.           ctl: controlfield;    {control field}
  54.           inf: infofield;       {information field}
  55.  
  56.         end;
  57.  
  58.         lcb = record
  59.           lineno: 0..31;                {physical line in system}
  60.           baudrate: integer;            {system clock divisor baud rate}
  61.           clockrate: integer;           {system clock divisor for 100 ms}
  62.           timeout: 0..255;              {100 ms. clock ticks for T1}
  63.           a1: array[1..7] of byte;
  64.           chfree: boolean;              {current line state}
  65.           modemchar: code;              {modem characteristics}
  66.           modemout: byte;               {modem output status byte}
  67.           modemin: byte;                {modem input status byte}
  68.           a2: array[1..19] of byte;
  69.           rcvstatus: code;              {rcv status}
  70.           rcvmsg: mcb;                  {rcv message location}
  71.           rcvframes: qcb;               {rcv frames queue}
  72.           a3: array[1..10] of byte;
  73.           xmtstatus: code;              {xmt status}
  74.           xmtmsg: mcb;                  {xmt message location}
  75.           xmtframes: qcb;               {xmt frames queue}
  76.           a4: array[1..8] of byte;
  77.  
  78.         end;
  79.  
  80. var     qfree: qcb;             {free buffer pool}
  81.         msg: mcbptr;            {incoming message temporary}
  82.         line: lcb;              {line control block}
  83.         iorun: boolean;         {run flag}
  84.         timecount: integer;     {counter for main delay loop}
  85.         freecount: integer;     {counter for channel free condition}
  86.         fp0,fp1,fp2,fp3: frmptr;    {frame pointer temporaries}
  87.         fp4,fp5,fp6,fp7: frmptr;    {frame pointer temporaries}
  88.         i,j,k: integer;
  89.  
  90. (*$i+*)
  91.  
  92. procedure initio;external;                      {initialize interrupt system}
  93. procedure enable;external;      {turn on interrupt system, unfreeze proc. env.}
  94.  
  95. procedure lkopn(var line: lcb);external;        {initialize hdlc hardware}
  96. procedure lkcls(var line: lcb);external;        {deinit hdlc hardware}
  97. procedure lkrcv(var line: lcb);external;        {start packet receiver}
  98. procedure lkxmt(var line: lcb);external;        {start packet transmitter}
  99. procedure lksts(var line: lcb);external;        {line modem status}
  100.  
  101. procedure cwid(var line: lcb);external;         {cw identification}
  102. procedure delay(time: integer);external;        {100 msec delay loop}
  103.  
  104. {This procedure adds a frame to the end of the current list of frames.}
  105.  
  106. procedure enquepkt(var qhdr: qcb; var fp: frmptr);
  107.  
  108. var     mp: frmptr;             {pointer temporary}
  109.         empty: boolean;         {flag for an empty list}
  110.  
  111. begin   fp^.lnk.mcblk := nil;   {reset link to next message}
  112.         mp := qhdr.qcblk;       {first message in list}
  113.         empty := mp = nil;      {flag for an empty list}
  114.  
  115.       if not empty then {queue has messages already waiting}
  116.  
  117.         begin while mp^.lnk.mcblk<>nil do mp := mp^.lnk.mcblk; {find end list}
  118.               mp^.lnk.mcblk := fp;       {put message at end of list}
  119.         end
  120.  
  121.       else {queue is empty}
  122.  
  123.         begin   qhdr.qcblk := fp     {just add a new message}
  124.         end;
  125. end;
  126.  
  127. {This procedure initializes the receive frames and starts the receiver}
  128.  
  129. procedure startrcvr;
  130.  
  131. var     fpr: frmptr;                    {temporary frame pointer}
  132.  
  133. begin   line.rcvframes.qcblk := nil;    {reset the rcv queue}
  134.         enquepkt(line.rcvframes,fp0);   {enque frame for receiving}
  135.         enquepkt(line.rcvframes,fp1);   {enque frame for receiving}
  136.         enquepkt(line.rcvframes,fp2);   {enque frame for receiving}
  137.         enquepkt(line.rcvframes,fp3);   {enque frame for receiving}
  138.         enquepkt(line.rcvframes,fp4);   {enque frame for receiving}
  139.         enquepkt(line.rcvframes,fp5);   {enque frame for receiving}
  140.         enquepkt(line.rcvframes,fp6);   {enque frame for receiving}
  141.         enquepkt(line.rcvframes,fp7);   {enque frame for receiving}
  142.         fpr := fp0;                     {initialize chain}
  143.         repeat
  144.         fpr^.lnk.mcbvl := 0;            {zero frame status}
  145.         fpr^.len := 2 + maxinfofld + 2; {set packet length maximum size + crc}
  146.         fpr := fpr^.lnk.mcblk;          {next frame in list}
  147.         until fpr = nil;                {end of list}
  148.         lkrcv(line);                    {start the receiver}
  149.  
  150. end;
  151.  
  152. {This procedure initializes a new frame for transmission.}
  153.  
  154. procedure fillpkt(fp: frmptr;adr: addressfield;ctl: controlfield;
  155.                   tfcount: integer;textstr:textfield);
  156.  
  157. var i: integer;
  158.  
  159. begin   fp^.len := 4 + tfcount;         {total xmt count}
  160.         fp^.res := 0;                   {no residual bits}
  161.         fp^.adr := adr;                 {initialize address field}
  162.         fp^.ctl := ctl;                 {initialize control field}
  163.         for i := 1 to tfcount do fp^.inf[i-1] := ord(textstr[i]); {move text}
  164.         fp^.inf[tfcount] := 13;         {add carriage return}
  165.         fp^.inf[tfcount+1] := 10;       {add line feed}
  166. end;
  167.  
  168. {Send packets out for the beacon}
  169.  
  170. procedure beacon;
  171.  
  172. begin   line.xmtframes.qcblk := nil;    {reset the xmt queue}
  173.         fillpkt(fp0,255,0,70,
  174.   'This is the KA6M ASCII/HDLC beacon in Menlo Park, California  Rev 2.10');
  175.         fillpkt(fp1,255,2,69,
  176.   'The quick brown fox jumped over the lazy dog''s back. 0123456789 !@#$% ');
  177.         fillpkt(fp2,255,20,70,
  178.   'You are receiving the signal of San Francisco''s first packet repeater.');
  179.         enquepkt(line.xmtframes,fp0);   {enque frame 0}
  180.         enquepkt(line.xmtframes,fp1);   {enque frame 1}
  181.         enquepkt(line.xmtframes,fp2);   {enque frame 2}
  182.         lkxmt(line);                    {transmit the packets}
  183.         while line.xmtstatus = 0 do ;   {wait for end of xmt}
  184. end;
  185.  
  186. {Validate and repeat a packet.}
  187.  
  188. procedure retransmit;
  189.  
  190. var     fpt: frmptr;                    {frame being examined}
  191.         fptnx: frmptr;                  {next frame in linkage}
  192.         adr: addressfield;              {local storage for address}
  193.         adrok: boolean;                 {address in range flag}
  194.         pst: 0..255;                    {packet status}
  195.         pktok: boolean;                 {packet status acceptable flag}
  196.  
  197. begin   line.xmtframes.qcblk := nil;    {reinit transmit queue}
  198.         fpt := fp0;                     {pointer to first frame in chain}
  199.         repeat
  200.           fptnx := fpt^.lnk.mcblk;        {get next frame in linkage}
  201.           adr := fpt^.adr;                {get received address}
  202.           adrok := (adr>=128) and (adr<160); {address in range}
  203.           pst := fpt^.lnk.mcbvl;          {packet status}
  204.           pktok := (pst=3) or (pst=7);    {packet status without errors}
  205.           if adrok and pktok then         {repeat the packet}
  206.            begin
  207.            fpt^.len := fpt^.cnt;          {set transmit length}
  208.            fpt^.res := 0;                 {no residue bits}
  209.            fpt^.adr := fpt^.adr+32;       {use sender's address offset by 32}
  210.            enquepkt(line.xmtframes,fpt);  {place frame onto transmit queue}
  211.            end;
  212.           fpt := fptnx;                   {point to next frame, if any}
  213.         until fptnx = nil;                {stop if end of chain}
  214.         if line.xmtframes.qcblk <> nil then {if there any good packets}
  215.           begin
  216.           lkxmt(line);                    {transmit them}
  217.           while line.xmtstatus = 0 do {nothing};  {wait for end of transmit}
  218.           end;
  219.         startrcvr;                        {restart receiver}
  220.  
  221. end;
  222.  
  223.  
  224. begin   {main program}
  225.  
  226. initio;                                 {set up interrupt world}
  227. lkopn(line);                            {initialize the hardware}
  228. enable;                                 {turn on interrupt system}
  229. new(fp0);new(fp1);new(fp2);new(fp3);    {allocate some frames}
  230. new(fp4);new(fp5);new(fp6);new(fp7);    {allocate some frames}
  231.  
  232. iorun := true;                          {run forever}
  233. while iorun do
  234.  begin  cwid(line);                     {identify}
  235.         beacon;                         {transmit beacon information}
  236.         startrcvr;                      {setup and start the receiver}
  237.         timecount := 3000;              {controls delay before next id}
  238.         freecount := 0;                 {controls free channel timer}
  239.         repeat                          {listen for packets loop}
  240.          delay(1);                      {wait 100 milliseconds}
  241.          lksts(line);                   {get current modem status}
  242.          if ((fp0^.lnk.mcbvl<>1) and line.chfree) then retransmit; {repeat pkt}
  243.          if not line.chfree then freecount := 0 {count up 30 sec of clear chnl}
  244.                         else freecount := freecount + 1;
  245.          if timecount <> 0 then timecount := timecount - 1; {countdown cwid}
  246.         until
  247.          (timecount = 0) and (freecount > 300);
  248.  
  249.  end;
  250.  
  251. lkcls(line);                            {close down the hardware}
  252.  
  253. end.
  254.