app.pll

来自「一个嵌入式系统的C代码」· PLL 代码 · 共 157 行

PROGRAM Application(INPUT, OUTPUT);

{-----------------------------------------------------------}
{ PURPOSE: ACME Application harness                         }
{          - harness for eventual ACME application          }
{          - used as a test mechanism to observe what users }
{            do with it				            }
{          - works in conjunction with a log process        }
{ AUTHOR:  David Jones                                      }
{ DATE:    1-MAY-95   Created                               }
{-----------------------------------------------------------}

CONST
  NUM_ELEMENTS = 5;  {** Number of elements in array **}
  QUEUE_START  = 3; {** INDEX WHERE QUEUE STARTS **}

VAR
  logging_shm, process_id, action_id : INTEGER;

{*******************************************}
{ ConnectIPC                                }
{   - either create and initialise shared   }
{     memory, OR                            }
{   - connect to the existing shared memory }
{   - shm id is returned as VAR parameter   }
{*******************************************}

FUNCTION ConnectIPC : INTEGER;
VAR
  result, count : INTEGER;

BEGIN
  logging_shm := SYSTEM( SHR_OPEN, 'myshm' );
  IF logging_shm <= 0 THEN
  BEGIN
    logging_shm := SYSTEM( SHR_CREATE, 'myshm', NUM_ELEMENTS*2+QUEUE_START );

    {** Initialise shared memory data structure **}
    result := SYSTEM( SHR_WRITE, logging_shm, 0, 0 );
    result := SYSTEM( SHR_WRITE, logging_shm, 1, QUEUE_START );
    result := SYSTEM( SHR_WRITE, logging_shm, 2, QUEUE_START );

    FOR count := QUEUE_START TO NUM_ELEMENTS*2+QUEUE_START-1 DO
    BEGIN
      result := SYSTEM( SHR_WRITE, logging_shm, count, -1 )
    END
  END;
  ConnectIPC := 1
END;

{********************************************}
{ CloseIPC				     }
{   - free up any IPC primitives used        }
{********************************************}

PROCEDURE CloseIPC;
VAR
  result : INTEGER;
BEGIN
  result := SYSTEM( SHR_CLOSE, logging_shm );
END;

{********************************************}
{ GetProcessId                               }
{   - obtain from shm passed in as parameter }
{     this process' unique identifier number }
{   - each version of ACME application is    }
{     given a unqiue id			     }
{********************************************}

FUNCTION GetProcessId : INTEGER;
VAR
  result, id : INTEGER;

BEGIN
  {* Process Id is first element in SHM *}
  id := SYSTEM( SHR_READ, logging_shm, 0 );

  {* update the process id for next process *}
  id := id + 1;
  result := SYSTEM( SHR_WRITE, logging_shm, 0, id );

  GetProcessId := id - 1
END;

{********************************************}
{ LogAction                                  }
{   - store the action performed by the      }
{     process into shared memory             }
{   - only do so if there is space in shm    }
{   - othewise report an error and don't     }
{     write it                               }
{********************************************}

PROCEDURE LogAction;
VAR
  free, result : INTEGER;

BEGIN
  {* get location of next free element *}
  free := SYSTEM( SHR_READ, logging_shm, 1 );

  {* examine free location to see if it is free *}
  result := SYSTEM( SHR_READ, logging_shm, free );

  IF result = -1 THEN
  BEGIN
    {* space is free so insert the new process and action id *}
    result := SYSTEM( SHR_WRITE, logging_shm, free, process_id );
    result := SYSTEM( SHR_WRITE, logging_shm, free+1, action_id );
    {* update the free ptr *}
    free := free + 2;
    IF free = NUM_ELEMENTS * 2 + QUEUE_START THEN
      free := QUEUE_START;
    result := SYSTEM( SHR_WRITE, logging_shm, 1, free )
  END
  ELSE
  BEGIN
    Writeln( '*********' );
    Writeln( '**ERROR** log is full' );
    Writeln( '*********' )
  END

END;

PROCEDURE DoAction;
BEGIN
  REPEAT
    Writeln( '   Welcome to ACMEs' );
    Writeln( 'Wonderful Application' );
    Writeln;
    Writeln( '1)        Create new user' );
    Writeln( '2)        Delete user' );
    Writeln( '3)        View users' );
    Writeln( '4)        Exit' );
    Writeln;
    Write( 'Please enter your choice --> ' );
    Read( action_id# );

    LogAction
  UNTIL action_id = 4
END;

BEGIN
  IF ConnectIPC = 1 THEN
  BEGIN
    process_id := GetProcessId;
    DoAction;
    CloseIPC
  END
  ELSE
    Writeln( '** UNABLE TO OPEN IPC PRIMITIVES **' )

END.

{------------------------------ EOF -----------------------------}