--
-- Exemples d'appel systemes depuis Ada
--   (extraits d'un plus gros programme, je ne garantis pas le fonctionnement)
--
--    D. Thonon SEMA-GROUP Meylan
--    le 3-10-89
--

with TEXT_IO; use TEXT_IO;
with SYSTEM;		   -- Types propres au materiel (WORD...)
with STARLET;		   -- Interface Ada des appels systemes VMS 
with TASKING_SERVICES;	   -- Interface Ada-VMS synchrone 
with UNCHECKED_CONVERSION; -- Conversion de types materiels
with CONDITION_HANDLING;

procedure DEMO is

    TT_IP_CHAN: STARLET.CHANNEL_TYPE;		-- Channel d'entrée pour QIOW

    STATUT: CONDITION_HANDLING.COND_VALUE_TYPE; -- Code retour STARLET

    BIDON: SYSTEM.UNSIGNED_WORD;
    IP_TERM: STRING(1..10);
    ITEMS: STARLET.ITEM_LIST_TYPE(1..2) :=
	     (1 => (BUF_LEN     => SYSTEM.UNSIGNED_WORD'(10), 
		    ITEM_CODE   => STARLET.LNM_STRING,
		    BUF_ADDRESS => IP_TERM'ADDRESS,
		    RET_ADDRESS => BIDON'ADDRESS),
	      2 => (BUF_LEN     => SYSTEM.UNSIGNED_WORD'(0), 
		    ITEM_CODE   => SYSTEM.UNSIGNED_WORD'(0),
		    BUF_ADDRESS => SYSTEM.ADDRESS_ZERO,
		    RET_ADDRESS => SYSTEM.ADDRESS_ZERO));

    READ_BUF: STRING(1..10);
    READ_IOSB: STARLET.IOSB_TYPE;
    ITEMLIST: STARLET.ITEM_LIST_TYPE(0..1);

    TYPE TERMINATOR_INFO_TYPE is array (1..2) of SYSTEM.UNSIGNED_WORD;
    TERMINATOR_INFO: TERMINATOR_INFO_TYPE;

    function WORD_TO_POSITIVE is
	new UNCHECKED_CONVERSION(SYSTEM.UNSIGNED_WORD,
				 POSITIVE);

     function DEV_TO_TERMINATOR is
	new UNCHECKED_CONVERSION(SYSTEM.UNSIGNED_LONGWORD,
				 TERMINATOR_INFO_TYPE);

begin

	STARLET.TRNLNM(
	    STATUS => STATUT,
	    TABNAM => "LNM$PROCESS_TABLE",
	    LOGNAM => "TT",
	    ITMLST => ITEMS);
	if not CONDITION_HANDLING.SUCCESS(STATUT) then
	    TEXT_IO.PUT_LINE("APPEL: STARLET.TRNLNM");
	end if;

    -- Ouverture du Channel
    STARLET.ASSIGN (
	STATUS	=> STATUT,
	DEVNAM	=> IP_TERM,
	CHAN	=> TT_IP_CHAN);
    if not CONDITION_HANDLING.SUCCESS(STATUT) then
	TEXT_IO.PUT_LINE("APPEL: STARLET.ASSIGN");
    end if;

    -- Initialisation du terminal
    ITEMLIST(0).BUF_LEN:= 0;
    ITEMLIST(0).ITEM_CODE:= STARLET.TRM_ESCTRMOVR;
    ITEMLIST(0).BUF_ADDRESS:= SYSTEM.TO_ADDRESS(8);
    ITEMLIST(0).RET_ADDRESS:= SYSTEM.ADDRESS_ZERO; 
    ITEMLIST(1).BUF_LEN:= 0;
    ITEMLIST(1).ITEM_CODE:= STARLET.TRM_MODIFIERS;
    ITEMLIST(1).BUF_ADDRESS:= SYSTEM.TO_ADDRESS(
	    STARLET.TRM_M_TM_ESCAPE +
	    STARLET.TRM_M_TM_NOECHO +
	    STARLET.TRM_M_TM_NOFILTR );
    ITEMLIST(1).RET_ADDRESS:= SYSTEM.ADDRESS_ZERO; 

    TASKING_SERVICES.TASK_QIOW(
	STATUS  => STATUT,
	CHAN    => TT_IP_CHAN,
	FUNC    => SYSTEM."OR"(STARLET.IO_READVBLK,
			       STARLET.IO_M_EXTEND),
	IOSB    => READ_IOSB,
	P1      => SYSTEM.TO_UNSIGNED_LONGWORD(READ_BUF'ADDRESS),
	P2      => SYSTEM.UNSIGNED_LONGWORD(READ_BUF'LENGTH)
	,
	P5	=> SYSTEM.TO_UNSIGNED_LONGWORD(ITEMLIST'ADDRESS),
	P6	=> SYSTEM.UNSIGNED_LONGWORD(ITEMLIST'SIZE/8)
	);
    if not CONDITION_HANDLING.SUCCESS(STATUT) then
	TEXT_IO.PUT_LINE(" APPEL: TASKING_SERVICES.TASK_QIOW"); 
    end if;
    TERMINATOR_INFO:= DEV_TO_TERMINATOR(READ_IOSB.DEV_INFO);
    -- Interpretation du terminateur 
    --PARSE_TERMINATOR(READ_BUF(WORD_TO_POSITIVE(READ_IOSB.COUNT)+1 ..
    --	WORD_TO_POSITIVE(SYSTEM."+"(READ_IOSB.COUNT,TERMINATOR_INFO(2)))));

end DEMO;