home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 15 / 15.iso / s / s038 / 1.ddi / SUPP.LIF / H550DRV.P38 < prev    next >
Encoding:
Text File  |  1992-07-06  |  9.5 KB  |  390 lines
  1. $COMPACT(h550drv -CONST IN CODE- HAS
  2. $        h550drv,
  3. $         xh550;
  4. $        EXPORTS
  5. $         host$550$init,
  6. $         host$550$finish,
  7. $         host$550$setup,
  8. $         host$550$output,
  9. $         host$550$answer,
  10. $         host$550$hangup,
  11. $         host$550$utility,
  12. $         host$550$check)
  13. h550drv:
  14. DO;
  15.  
  16. $include(/rmx386/inc/rmxplm.ext)
  17. $include(/rmx386/inc/error.lit)
  18. $include(/rmx386/inc/common.lit)
  19. $include(/rmx386/inc/io.lit)
  20. $include(lddinfo.lit)
  21. $include(lddvers.lit)
  22.  
  23. host$550$init: PROCEDURE(cdata$p) EXTERNAL;
  24.     DECLARE
  25.         cdata$p                POINTER;
  26. END host$550$init;
  27.  
  28. host$550$finish: PROCEDURE(cdata$p) EXTERNAL;
  29.     DECLARE
  30.         cdata$p                POINTER;
  31. END host$550$finish;
  32.  
  33. host$550$setup: PROCEDURE(udata$p) EXTERNAL;
  34.     DECLARE
  35.         udata$p                POINTER;
  36. END host$550$setup;
  37.  
  38. host$550$answer: PROCEDURE(udata$p) EXTERNAL;
  39.     DECLARE
  40.         udata$p                POINTER;
  41. END host$550$answer;
  42.  
  43. host$550$hangup: PROCEDURE(udata$p) EXTERNAL;
  44.     DECLARE
  45.         udata$p                POINTER;
  46. END host$550$hangup;
  47.  
  48. host$550$utility: PROCEDURE(udata$p) EXTERNAL;
  49.     DECLARE
  50.         udata$p                POINTER;
  51. END host$550$utility;
  52.  
  53. host$550$check: PROCEDURE(cdata$p) EXTERNAL;
  54.     DECLARE
  55.         cdata$p                POINTER;
  56. END host$550$check;
  57.  
  58. DECLARE
  59.     dinfo_550(1)                    BYTE EXTERNAL DATA,
  60.     num_duibs                        BYTE EXTERNAL DATA,
  61.     duibtable(1)                    BYTE EXTERNAL DATA;
  62.  
  63. host$550$output: PROCEDURE(udata$p,output$char) REENTRANT PUBLIC;
  64.     DECLARE
  65.         udata$p                POINTER,
  66.         output$char            BYTE;
  67.  
  68.     RETURN;
  69. END host$550$output;
  70.  
  71. DECLARE
  72.     duib$p                        POINTER,
  73.     duib    BASED    duib$p (1)    DUIB$STRUCT,
  74.     dinfo$p                        POINTER,
  75.     dinfo    BASED    dinfo$p        LOADABLE$TERM$DINFO,
  76.     local$dinfo    BASED    dinfo$p    STRUCTURE(
  77.         term$dinfo                            LOADABLE$TERM$DINFO,
  78.         port$base                            WORD,
  79.         reset$char                            BYTE,
  80.         break$char                            BYTE),
  81.     uinfo$p                        POINTER,
  82.     uinfo    BASED    uinfo$p        STRUCTURE(
  83.         conn$flags                            WORD,
  84.         term$flags                            WORD,
  85.         in$baud$rate                        DWORD,
  86.         out$baud$rate                        DWORD,
  87.         scroll$count                        WORD);
  88.  
  89. DECLARE
  90.         co$conn$t            TOKEN,
  91.         root$t                TOKEN,
  92.         HI$job$$t            TOKEN,
  93.         parent$job$t        TOKEN,
  94.         input$buff(128)        BYTE,
  95.         status                WORD,
  96.         bytes$read            WORD,
  97.         del                    BYTE, /* Delimeter returned by get$argument */
  98.         num$channels        WORD,
  99.         IO$address            WORD,
  100.         interrupt$level        WORD,
  101.         exception$info        STRUCTURE(
  102.             entry$point            POINTER,
  103.             mode                BYTE),
  104.         NO$BUFFERS            LITERALLY    '0',
  105.         RT_PREN                LITERALLY    '29H',
  106.         ROOT_JOB            LITERALLY    '3',
  107.         PARENT_JOB            LITERALLY    '1',
  108.         NO$EXCEPTIONS        LITERALLY    '00',
  109.         sign$on$msg(*)        BYTE    DATA(CR,LF,
  110.         '   iRMX III Loadable Hostess 550 Terminal Driver Front End',CR,LF,LF),
  111.         badparm$msg(*)        BYTE DATA(CR,LF,
  112.             'Invalid Command Tail',CR,LF), /* Unknown parameter msg */
  113.         missing$parm$msg(*)        BYTE DATA(CR,LF,
  114.             'Missing input parameter',CR,LF), /* missing input parm msg */
  115.         invalid$parm$msg(*)        BYTE DATA(CR,LF,
  116.             'Invalid input parameter',CR,LF), /* invalid input parm msg */
  117.         usage$msg(*)        BYTE DATA(CR,LF,
  118.     'USAGE: h550drv( (Hostess 550 Number of channels (4 or 8)),',CR,LF,
  119.     '                (Hostess 550 I/O Address(in HEX)),',CR,LF,
  120.     '                (Hostess 550 Encoded Interrupt Level))',CR,LF);
  121.  
  122. DECLARE
  123.     version(*)                BYTE DATA(H550$version,H550$name,0);
  124.  
  125. $subtitle('CONVERT')
  126. convert: PROCEDURE(char$p) DWORD REENTRANT;
  127.  
  128.     DECLARE
  129.         char$p                        POINTER,
  130.         char    BASED    char$p    (1)    BYTE,
  131.         char$value                    BYTE,
  132.         value                        DWORD,
  133.         i                            BYTE;
  134.  
  135.     value = 0;
  136.     DO i = 1 to char(0);
  137.         IF (char(i) < 30H) OR (char(i) > 46H) OR
  138.             ((char(i) > 39H) AND (char(i) < 41H)) THEN
  139.                 RETURN 0;
  140.         IF char(i) > 39H THEN
  141.             char$value = char(i) - 37H;
  142.         ELSE
  143.             char$value = char(i) - 30H;
  144.         value = (value * 16) + char$value;
  145.     END;
  146.     RETURN value;
  147.  
  148. END convert;
  149.  
  150. $subtitle('append$string')
  151. append$string: PROCEDURE(str1$p, str2$p) REENTRANT;
  152.  
  153.     DECLARE
  154.         str1$p                        POINTER,
  155.         str2$p                        POINTER,
  156.         str1    BASED    str1$p(1)    BYTE,
  157.         str2    BASED    str2$p(1)    BYTE,
  158.         i                            BYTE,
  159.         j                            BYTE;
  160.  
  161.     j = str1(0);
  162.     DO i = 1 to str2(0);
  163.         str1(j+i) = str2(i);
  164.     END;
  165.     str1(0) = str1(0) + str2(0);
  166.  
  167. END append$string;
  168.  
  169. $subtitle('Check Exception')
  170. check$exception: PROCEDURE(exception, info$p) REENTRANT;
  171.  
  172.     DECLARE
  173.             exception                WORD,
  174.             info$p                    POINTER,
  175.             info    BASED    info$p    STRUCTURE(
  176.                 count                BYTE,
  177.                 char(1)                BYTE),
  178.             exc$buf                    STRUCTURE(
  179.                 count                BYTE,
  180.                 char(80)            BYTE),
  181.             dummy                    WORD;
  182.  
  183.     IF exception <> E$OK THEN
  184.     DO;
  185.         CALL dq$decode$exception(exception, @exc$buf, @dummy);
  186.         CALL dq$write(co$conn$t, @(CR,LF), 2, @dummy);
  187.         CALL dq$write(co$conn$t, @exc$buf.char, exc$buf.count, @dummy);
  188.         CALL dq$write(co$conn$t, @(': '), 2, @dummy);
  189.         IF info$p <> NIL THEN
  190.             CALL dq$write(co$conn$t, @info.char, info.count, @dummy);
  191.         CALL dq$write(co$conn$t, @(CR,LF), 2, @dummy);
  192.  
  193.         CALL dq$detach(co$conn$t,@status);
  194.  
  195.         CALL rq$delete$job (SELECTOR$OF(NIL), @status);
  196.  
  197.         CALL rq$suspend$task(SELECTOR$OF(NIL),@status);    /* if all else fails */
  198.     END;
  199.  
  200. END check$exception;
  201.  
  202.  
  203. /*
  204.  *        MAIN PROGRAM
  205.  */
  206.  
  207.     /*
  208.      *    Turn off exceptions
  209.      */
  210.  
  211.     exception$info.mode = NO$EXCEPTIONS;
  212.     CALL rq$set$exception$handler( @exception$info, @status);
  213.  
  214.     /*
  215.      * Get the arguments.  The first one should be the name
  216.      * of this program.
  217.      */
  218.  
  219.     del = dq$get$argument(@input$buff, @status );
  220.  
  221.     /*
  222.      * Create a log file for the program 
  223.      */
  224.     IF status = E$OK THEN
  225.     DO;
  226.         /* log file name = <prog name>.log */
  227.  
  228.         CALL append$string (@input$buff, @(4,'.log')); 
  229.     END;
  230.     ELSE
  231.     DO;
  232.         input$buff(0) = 0;
  233.         CALL append$string (@input$buff, @(17,'/work/h550drv.log')); 
  234.     END;
  235.  
  236.     /*
  237.      * Create a connection to the log file
  238.      */
  239.  
  240.     co$conn$t = dq$create(@input$buff, @status );
  241.     CALL check$exception(status,NIL);
  242.             
  243.     CALL dq$open( co$conn$t, WRITE$ONLY, NO$BUFFERS, @status );
  244.  
  245.     CALL dq$write(co$conn$t,@sign$on$msg,LENGTH(sign$on$msg),@status);
  246.     CALL check$exception(status,NIL);
  247.  
  248.     /*
  249.      * If the delimeter is a CR or LF then there are no parameters.
  250.      * This is an error so print out the usage message.
  251.      */
  252.  
  253.     IF (del = CR) OR (del = LF) THEN
  254.     DO;
  255.         CALL dq$write(co$conn$t,@usage$msg,LENGTH(usage$msg),@status);
  256.         GOTO exit;
  257.     END;
  258.  
  259.     /* Get Number of Channels */
  260.  
  261.     del = dq$get$argument(@input$buff,@status);
  262.     CALL check$exception(status,NIL);
  263.     IF (del = CR) OR (del = LF) OR (input$buff(0) = 0) THEN
  264.     DO;
  265.         CALL dq$write(co$conn$t,@missing$parm$msg,
  266.                       LENGTH(missing$parm$msg),@status);
  267.         CALL dq$write(co$conn$t,@usage$msg,LENGTH(usage$msg),@status);
  268.         GOTO exit;
  269.     END;
  270.  
  271.     num$channels = convert(@input$buff);
  272.  
  273.     IF (num$channels <> 4) AND (num$channels <> 8) 
  274.        AND (num$channels <> 16) THEN
  275.     DO;
  276.         CALL dq$write(co$conn$t,@invalid$parm$msg,
  277.                       LENGTH(invalid$parm$msg),@status);
  278.         CALL dq$write(co$conn$t,@usage$msg,LENGTH(usage$msg),@status);
  279.         GOTO exit;
  280.     END;
  281.  
  282.     /* Get Hostess 550 I/O Base Address */
  283.  
  284.     del = dq$get$argument(@input$buff,@status);
  285.     CALL check$exception(status,NIL);
  286.     IF (del = CR) OR (del = LF) OR (input$buff(0) = 0) THEN
  287.     DO;
  288.         CALL dq$write(co$conn$t,@missing$parm$msg,
  289.                       LENGTH(missing$parm$msg),@status);
  290.         CALL dq$write(co$conn$t,@usage$msg,LENGTH(usage$msg),@status);
  291.         GOTO exit;
  292.     END;
  293.  
  294.     IO$address = convert(@input$buff);
  295.  
  296.     /* Get Hostess 550 Interrupt Level */
  297.  
  298.     del = dq$get$argument(@input$buff,@status);
  299.     CALL check$exception(status,NIL);
  300.     IF (del = CR) OR (del = LF) OR (input$buff(0) = 0) THEN
  301.     DO;
  302.         CALL dq$write(co$conn$t,@missing$parm$msg,
  303.                       LENGTH(missing$parm$msg),@status);
  304.         CALL dq$write(co$conn$t,@usage$msg,
  305.                       LENGTH(usage$msg),@status);
  306.         GOTO exit;
  307.     END;
  308.  
  309.     interrupt$level = convert(@input$buff);
  310.  
  311. load$driver:
  312.  
  313.     dinfo$p = BUILD$PTR(
  314.                 rqe$create$descriptor(
  315.                     rqe$get$address(@dinfo_550,@status),
  316.                     SIZE(local$dinfo),
  317.                     @status),0);
  318.     CALL check$exception(status,@input$buff);
  319.  
  320.     dinfo.interrupt$level = interrupt$level;
  321.     local$dinfo.port$base = IO$address;
  322.     dinfo.num$units = num$channels;
  323.  
  324.     CALL rqe$delete$descriptor(SELECTOR$OF(dinfo$p),@status);
  325.     CALL check$exception(status,@input$buff);
  326.  
  327.     IF num$channels = 4 THEN
  328.     DO;
  329.         duib$p = BUILD$PTR(
  330.                     rqe$create$descriptor(
  331.                         rqe$get$address(@duibtable,@status),
  332.                         (SIZE(duib) * 8),
  333.                         @status),0);
  334.         CALL check$exception(status,@input$buff);
  335.  
  336.         /*    Null out DUIB names for channels 4 thru 7 */
  337.         CALL SETB(20H,@duib(4).name,14);
  338.         CALL SETB(20H,@duib(5).name,14);
  339.         CALL SETB(20H,@duib(6).name,14);
  340.         CALL SETB(20H,@duib(7).name,14);
  341.  
  342.         CALL rqe$delete$descriptor(SELECTOR$OF(duib$p),@status);
  343.         CALL check$exception(status,@input$buff);
  344.     END;
  345.  
  346.     duib$p = @duibtable;
  347.  
  348.     CALL rq$install$duibs(num$channels,
  349.                           duib$p,
  350.                           NIL,
  351.                           @status);
  352.     CALL check$exception(status,NIL);
  353.  
  354.     root$t = rq$get$task$tokens(ROOT_JOB,@status);
  355.     CALL check$exception(status,NIL);
  356.  
  357.     HI$job$t = rq$lookup$object(root$t,@(8,'R?HI$JOB'),0,@status);
  358.     CALL check$exception(status,NIL);
  359.  
  360.     parent$job$t = rq$get$task$tokens(PARENT_JOB,@status);
  361.     CALL check$exception(status,NIL);
  362.  
  363.     CALL rq$catalog$object(HI$job$t,parent$job$t,
  364.                             @(11,'H550DRV_JOB'),@status);
  365.     IF status = E$CONTEXT THEN
  366.     DO;
  367.         CALL rq$uncatalog$object(HI$job$t,
  368.                                     @(11,'H550DRV_JOB'),@status);
  369.         CALL rq$catalog$object(HI$job$t,parent$job$t,
  370.                                     @(11,'H550DRV_JOB'),@status);
  371.     END;
  372.  
  373.     CALL dq$detach(co$conn$t,@status);    /* detach the log file */
  374.  
  375.     CALL rq$suspend$task(SELECTOR$OF(NIL),@status);
  376.  
  377. exit:
  378.  
  379.     /*
  380.      * Clean up.  Detach :CO:.
  381.      */
  382.  
  383.     CALL dq$detach(co$conn$t,@status);
  384.  
  385.     CALL rq$delete$job (SELECTOR$OF(NIL), @status);
  386.  
  387.     CALL rq$suspend$task(SELECTOR$OF(NIL),@status);    /* if all else fails */
  388.  
  389. END h550drv;
  390.