{* ASYNC1 *} $standard_level 'ext_modcal'$ $list off$ {------------------------------------------------------------------- program ASYNC1 -------------------------------------------------------------------- PURPOSE: This is a simple program to illustrate the use of asynchronous ports. 1. Call GETPRIVMODE to gain user privilege level 2. 2. Create and open an asynchronous port using AIFPORTOPEN. 3. Create and open a synchronous port using AIFPORTOPEN. 4. Send message with AIFPORTSEND to notify the other process the asynchronous port exists. 5. Pause to wait for a message. 6. The other program will send multiple messages to the asynchronous port which will cause the interrupt handler to run. 7. Use AIFPORTINT to disable/enable interrupts in the handler. 8. Call AIFPORTRECEIVE to receive the message in the handler. 9. Use AIFPORTCLOSE and close each port. 10. Call GETUSERMODE. PARAMETERS: None. -------------------------------------------------------------------} program ASYNC1 ( input, output ); type status_type = record case boolean of true : (all : integer); false : (info : shortint; subsys : shortint); end; bit32 = packed array [1..32] of boolean; item_array_type = array [1..5] of globalanyptr; itemnum_array_type = array [1..5] of integer; item_status_array_type = array [1..5] of status_type; message_buffer_type = packed array [1..80] of char; name_type = packed array [1..16] of char; {------------------------------------------------------------------- declare structured constants to initialize arrays used in various AIF procedure calls -------------------------------------------------------------------} const Init_Item_Array = item_array_type [5 of nil]; Init_Itemnum_Array = itemnum_array_type [5 of 0]; Init_Item_Status_Array = item_status_array_type [5 of status_type [info : 0, subsys : 0]]; var accessmode : integer; createoptions : integer; createhandler : bit32; createstate : boolean; envelope_code : integer; interval : real; itemnum_ports : itemnum_array_type; item_ports : item_array_type; item_status_ports : item_status_array_type; maxmsgsize : integer; message_buffer : message_buffer_type; message_id : integer; message_length : integer; newstates : array [1..2] of boolean; overall_status : status_type; portid1 : integer; portid2 : integer; portlist : array [1..2] of integer; oldstates : array [1..2] of integer; portname : name_type; portpass : name_type; proc_name : packed array [1..13] of char; proc_file : packed array [1..8] of char; user_id : integer; timeoutseconds : integer; procedure GETPRIVMODE; intrinsic; procedure GETUSERMODE; intrinsic; procedure HPGETPROCPLABEL; intrinsic; procedure PAUSE; intrinsic; procedure QUIT; intrinsic; $sysintr 'aifintr.pub.sys'$ procedure AIFPORTCLOSE; intrinsic; procedure AIFPORTINT; intrinsic; function AIFPORTOPEN : integer; intrinsic; procedure AIFPORTRECEIVE; intrinsic; procedure AIFPORTSEND; intrinsic; {------------------------------------------------------------------- procedure ERROR_IN_CALL -------------------------------------------------------------------- PURPOSE: This procedure will accept an intrinsic call name and status variable. It will output a message naming the offending call and status information and subsystem parameters. It will call QUIT to terminate the calling program and child processes. PARAMETERS: name - name of erroring AIF or intrinsic call status - status of call item_status_array - array of status values for item list -------------------------------------------------------------------} procedure ERROR_IN_CALL ( name : name_type; status : status_type; var item_status_array : item_status_array_type) option extensible 2; var index : shortint; quitnum : integer; begin { ERROR_IN_CALL } writeln ('Error in ',name); writeln ('Overall status info =',status.info, ' subsys =', status.subsys); if status.info > 0 then for index := 1 to status.info do writeln ('Index: ',index,' info =', item_status_array[index].info, ' subsys =',item_status_array[index].subsys); quitnum := 516; QUIT (quitnum); end; { ERROR_IN_CALL } {------------------------------------------------------------------- procedure PORTHANDLER -------------------------------------------------------------------- PURPOSE: This procedure is the handler for the asynchronous port. It illustrates the use of AIFPORTINT to disable port interrupts. It will use AIFPORTRECEIVE to get the message. It will reissue the AIFPORTRECEIVE to check if messages with pending interrupts have arrived. AIFPORTINT will enable port interrupts before exiting the handler. PARAMETERS: portid - contains the portid of the port with the incoming message this is a required parameter -------------------------------------------------------------------} procedure PORTHANDLER ( portid : integer ); var env_code : integer; hand_status : status_type; index : integer; item_porth : item_array_type; item_status_porth : item_status_array_type; itemnum_porth : itemnum_array_type; msg_buf : message_buffer_type; msg_id : integer; msg_len : integer; newstates : array[1..2] of boolean; oldstates : array[1..2] of boolean; pending : boolean; portlist : array[1..2] of integer; timeout : integer; begin { PORTHANDLER } {------------------------------------------------------------------- 7. AIFPORTINT is setup to disable interrupt handling on the current port. This is done when an application is accessing global data or has a critical section of code to protect. It is not necessary to call AIFPORTINT inside a handler. If new messages arrive, the interrupt handlers will nest. It is recommended the processing done in the handler be kept at a minimum. -------------------------------------------------------------------} hand_status.all := 0; newstates[1] := False; portlist[1] := portid; portlist[2] := 0; AIFPORTINT ( hand_status, portlist, newstates, oldstates ); if hand_status.all <> 0 then writeln ('AIFPORTINT 1 - Bad Status: info =',hand_status.info, ' subsys =', hand_status.subsys) else if oldstates[1] then writeln ('AIFPORTINT 1 (handler) -', ' Previous state of port is ENABLED.') else writeln ('AIFPORTINT 1 (handler) -', ' Previous state of port is DISABLED.'); {------------------------------------------------------------------- 8. AIFPORTRECEIVE is called to get the original message which caused the handler to be invoked. Variables should be initialized before the AIFPORTRECEIVE call. -------------------------------------------------------------------} msg_len := 80; env_code := 0; msg_id := 0; msg_buf := ' '; itemnum_porth := Init_Itemnum_Array; { zero array } item_porth := Init_Item_Array; item_status_porth := Init_Item_Status_Array; timeout := -1; { nowait receive } itemnum_porth[1] := 11002; { next element initialized to 0 } item_porth[1] := addr(timeout); AIFPORTRECEIVE ( hand_status, portid, msg_buf, msg_len, env_code, msg_id, itemnum_porth, item_porth, item_status_porth ); if hand_status.all <> 0 then begin writeln ('AIFPORTRECEIVE - Bad Status: info=' , hand_status.info, ' subsys =', hand_status.subsys); if hand_status.info > 0 then for index := 1 to hand_status.info do writeln ('Index: ',index,' info =', item_status_porth[index].info, ' subsys =',item_status_porth[index].subsys); end else writeln('AIFPORTRECEIVE (complete) - ' , msg_buf ); {------------------------------------------------------------------- The AIFPORTRECEIVE can be used to check if there are messages with pending interrupts. If the message is successfully received the pending interrupt will not occur when item 11007 is used. -------------------------------------------------------------------} msg_len := 80; env_code := 0; msg_id := 0; msg_buf := ' '; itemnum_porth := Init_Itemnum_Array; { zero array } item_porth := Init_Item_Array; item_status_porth := Init_Item_Status_Array; timeout := -1; { nowait receive } itemnum_porth[1] := 11002; item_porth[1] := addr(timeout); pending := True; itemnum_porth[2] := 11007; { next element initialized to 0 } item_porth[2] := addr(pending); while pending do begin { while pending } AIFPORTRECEIVE ( hand_status, portid, msg_buf, msg_len, env_code, msg_id, itemnum_porth, item_porth, item_status_porth ); if hand_status.all <> 0 then begin writeln ('AIFPORTRECEIVE - Bad Status: info=', hand_status.info, ' subsys =', hand_status.subsys); if hand_status.info > 0 then for index := 1 to hand_status.info do writeln ('Index: ',index,' info =', item_status_porth[index].info, ' subsys =', item_status_porth[index].subsys); pending := False; end else writeln('AIFPORTRECEIVE (pending) - ' , msg_buf ); end; { while pending } {------------------------------------------------------------------- Call AIFPORTINT to enable/arm interrupt handling -------------------------------------------------------------------} newstates[1] := oldstates[1]; AIFPORTINT ( hand_status, portlist, newstates, oldstates ); if hand_status.all <> 0 then writeln ('AIFPORTINT 2 - Bad Status: info =',hand_status.info, ' subsys =', hand_status.subsys) else if oldstates[1] then writeln ('AIFPORTINT 2 (handler) ', '- Previous state of port is ENABLED.') else writeln ('AIFPORTINT 2 (handler) ', '- Previous state of port is DISABLED.'); end; { PORTHANDLER } begin {ASYNC1} {------------------------------------------------------------------- 1. Call GETPRIVMODE to gain user privilege level 2 -------------------------------------------------------------------} GETPRIVMODE; {------------------------------------------------------------------- 2. Create and open an asynchronous port using AIFPORTOPEN. -------------------------------------------------------------------} writeln ('Enter a valid user id:'); readln (user_id); portname := 'aifport1 '; portpass := 'aifpass1 '; accessmode := 1; { receive access } itemnum_ports := Init_Itemnum_Array; { zero array } item_ports := Init_Item_Array; item_status_ports := Init_Item_Status_Array; createoptions := 2; { create new } itemnum_ports [1] := 11201; item_ports [1] := addr(createoptions); maxmsgsize := 80; { message size } itemnum_ports [2] := 11202; item_ports [2] := addr(maxmsgsize); proc_name := '#PORTHANDLER#'; proc_file := '#ASYNC1#'; HPGETPROCPLABEL ( proc_name, createhandler, overall_status, proc_file, False ); if overall_status.all <> 0 then ERROR_IN_CALL('HPGETPROCPLABEL',overall_status); itemnum_ports [3] := 11206; item_ports [3] := addr(createhandler); { handler address } createstate := True; itemnum_ports [4] := 11207; { next element initialized to 0 } item_ports [4] := addr(createstate); { handler enabled } portid1 := AIFPORTOPEN ( overall_status, portname, portpass, accessmode, user_id, itemnum_ports, item_ports, item_status_ports ); if overall_status.all <> 0 then ERROR_IN_CALL('AIFPORTOPEN',overall_status,item_status_ports); {------------------------------------------------------------------- 3. Create and open a synchronous port using AIFPORTOPEN. -------------------------------------------------------------------} portname := 'aifport2 '; portpass := 'aifpass2 '; accessmode := 2; { send access } itemnum_ports [3] := 0; { terminate item list } portid2 := AIFPORTOPEN ( overall_status, portname, portpass, accessmode, user_id, itemnum_ports, item_ports, item_status_ports ); if overall_status.all <> 0 then ERROR_IN_CALL('AIFPORTOPEN #2',overall_status, item_status_ports); {------------------------------------------------------------------- 4. Send message with AIFPORTSEND to notify the other process the asynchronous port exists. Once the asynchronous port exists the other process can open the port. The asynchronous port creator is the only receiver and must be the first opener. -------------------------------------------------------------------} message_buffer :='Asynchronous port open OK to send messages'; message_length := 80; itemnum_ports := Init_Itemnum_Array; { zero array } item_ports := Init_Item_Array; item_status_ports := Init_Item_Status_Array; timeoutseconds := 0; { wait for other process to recv message} item_ports[1] := ADDR(timeoutseconds); itemnum_ports[1] := 11101; { next element initialized to 0 } AIFPORTSEND ( overall_status, portid2, message_buffer, message_length, , , itemnum_ports, item_ports, item_status_ports ); if overall_status.all <> 0 then ERROR_IN_CALL('AIFPORTSEND',overall_status,item_status_ports); {------------------------------------------------------------------- 5. Pause to wait for a message. In a true application there would be real processing taking place. Otherwise, a synchronous port should be used if there is no work for the application to do. 6. The other program will send a message which will cause the interrupt handler to run. -------------------------------------------------------------------} interval := 60.0; PAUSE (interval); {------------------------------------------------------------------- 9. Close the ports. -------------------------------------------------------------------} AIFPORTCLOSE ( portid2, accessmode, overall_status ); if overall_status.all <> 0 then ERROR_IN_CALL('AIFPORTCLOSE',overall_status); AIFPORTCLOSE ( portid1, accessmode, overall_status ); if overall_status.all <> 0 then ERROR_IN_CALL('AIFPORTCLOSE #2',overall_status); {------------------------------------------------------------------- 10. Call GETUSERMODE -------------------------------------------------------------------} GETUSERMODE; writeln ('ASYNC1 terminated') end.