home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / intelmdsb / mdsset.p80 < prev    next >
Text File  |  2020-01-01  |  16KB  |  578 lines
  1. $TITLE ('SET MODULE')
  2. set$module:
  3.  
  4. /* COPYRIGHT (C) 1985, Trustees of Columbia University in the City of New */
  5. /* York.  Permission is granted to any individual or institution to use,  */
  6. /* copy, or redistribute this software so long as it is not sold for      */
  7. /* profit, provided this copyright notice is retained. /*
  8.  
  9. /* Contains the following public routines: sethelp, set */
  10. do;
  11.  
  12. /* SET: Process the several variations of the SET command */
  13.  
  14. declare port byte external;
  15. declare parity byte external;
  16. declare debug byte external;
  17. declare maxtry byte external;
  18. declare escchar byte external;
  19. declare halfduplex byte external; /* true or false */
  20. declare warning$flag byte external; /* how to handle dup file names */
  21. declare take$echo byte external; /* true or false */
  22. declare prompt(20) byte external; /* Kermit command prompt */
  23. declare def$prompt(20) byte external; /* Default command prompt */
  24.  
  25. declare null literally '000H';
  26. declare true literally '0FFH';
  27. declare false literally '00H';
  28. declare def$drive(5) byte external;
  29. declare subcmd byte;
  30. declare tokptr address;
  31. declare (new$drive based tokptr)(4) byte;
  32.  
  33. print:    procedure(msg) external;
  34.     declare msg address;
  35. end print;
  36.  
  37. /* SPIN: Searches a string for a character greater than blank */
  38. spin:   procedure (string) address external;
  39.     declare string address;
  40. end spin;
  41.  
  42. nout:    procedure(n) external;
  43.     declare n address;
  44. end nout;
  45.  
  46. newline: procedure external; end newline;
  47.  
  48. ioinit:    procedure external; end ioinit;
  49.  
  50. token: procedure address external;
  51. end token;
  52.  
  53. cmdtail: procedure address external;
  54. end cmdtail;
  55.  
  56. nin:    procedure (string) address external;
  57.     declare string address;
  58. end nin;
  59.  
  60. ready:    procedure (port) byte external;
  61.     declare port byte;
  62. end ready;
  63.  
  64. procbaud:    procedure (newbaud) byte external;
  65.     declare newbaud address;
  66. end procbaud;
  67.  
  68. putc:    procedure (c, port) external;
  69.     declare (c, port) byte;
  70. end putc;
  71.  
  72. getc:    procedure (port) byte external;
  73.     declare port byte;
  74. end getc;
  75.  
  76. ctl: procedure(char) byte external;
  77.     declare char byte;
  78. end ctl;
  79.  
  80. co: procedure(char) external;
  81.     declare char byte;
  82. end co;
  83.  
  84. movevar: procedure(offset, source, dest) byte external;
  85.     declare offset byte;
  86.     declare (source, dest) address;
  87. end movevar;
  88.  
  89. strcmp:    procedure (s1,s2) byte external;
  90.     declare (s1,s2) address;
  91. end strcmp;
  92.  
  93. varcmp:    procedure (s1,s2) byte external;
  94.     declare (s1,s2) address;
  95. end varcmp;
  96.  
  97. upcase: procedure (addr) external;
  98.     declare addr address;
  99. end upcase;
  100.  
  101. missop: procedure;
  102.     call print(.('Missing operand\$'));
  103. end missop;
  104.  
  105. badop: procedure;
  106.     call print(.('Invalid or ambiguous operand\$'));
  107. end badop;
  108.  
  109. /* ONIN: Octal number input conversion routine */
  110. onin:    procedure(string) address public;
  111.     declare string address;
  112.     declare result address;
  113.     declare c based string byte;
  114.  
  115.     result = 0;
  116.     if (string <> 0) then do;
  117.       string = spin(string);
  118.       do while (c >= '0') and (c <= '7');
  119.         result = result * 8 + (c - '0');
  120.         string = string + 1;
  121.       end;
  122.     end;
  123.     return result;
  124. end onin;
  125.  
  126. /* Pause for operator input */
  127. pause:    procedure;
  128.     declare c byte;
  129.     call print(.('Press <RETURN> to continue...$'));
  130.     c = getc(0);
  131.     call newline;
  132. end pause;
  133.  
  134. set$gen$help:    procedure;
  135.     call print(.('\SET\\$'));
  136.     call print(.('  The SET command is used to set various KERMIT $'));
  137.     call print(.('parameters.\\$'));
  138.     call print(.('Syntax:\\$'));
  139.     call print(.('    SET option [value]\\$'));
  140.     call print(.('The SET options are:\\$'));
  141.     call print(.('  BAUD-RATE   DEBUGGING   DISK        $'));
  142.     call print(.('DUPLEX      ESCAPE   PARITY\$'));
  143.     call print(.('  PORT        PROMPT      RETRY       $'));
  144.     call print(.('TAKE-ECHO   WARNING\\$'));
  145.     call print(.('You may request information on all of the $'));
  146.     call print (.('options by entering\\$'));
  147.     call print(.('           HELP SET ALL\\$'));
  148. end set$gen$help;
  149.  
  150. baudhelp:    procedure;
  151.     call print(.('\SET BAUD-RATE\\$'));
  152.     call print(.('  The BAUD-RATE option of the SET command is used $'));
  153.     call print(.('to set the communication\$'));
  154.     call print(.('baud rate.\\$'));
  155.     call print(.('Syntax:\\$'));
  156.     call print(.('    SET BAUD-RATE rate\\$'));
  157.     call print(.('Legal values for "rate" are 110, 150, 300, 600, $'));
  158.     call print(.('1200, 2400, 4800, 9600,\$'));
  159.     call print(.('and 19200.\\$'));
  160. end baudhelp;
  161.  
  162. debhelp:    procedure;
  163.     call print(.('\SET DEBUGGING\\$'));
  164.     call print(.('  The DEBUGGING option of the SET command is used $'));
  165.     call print(.('to control the display\$'));
  166.     call print(.('of debugging information.\\$'));
  167.     call print(.('Syntax:\\$'));
  168.     call print(.('    SET DEBUGGING [ON/OFF]\\$'));
  169.     call print(.('"SET DEBUGGING ON" will cause various status $'));
  170.     call print(.('information to be displayed\$'));
  171.     call print(.('while Kermit is executing.\\$'));
  172. end debhelp;
  173.  
  174. diskhelp:    procedure;
  175.     call print(.('\SET DISK\\$'));
  176.     call print(.('  The DISK option of the SET command is used $'));
  177.     call print(.('to set or clear the default\$'));
  178.     call print(.('ISIS disk drive.  The default disk drive will be $'));
  179.     call print(.('prefixed to any ISIS file\$'));
  180.     call print(.('name which does not already start with a drive.\\$'));
  181.     call print(.('Syntax:\\$'));
  182.     call print(.('    SET DISK [:Fn:]\$'));
  183.     call print(.('           or\$'));
  184.     call print(.('    SET DISK [n]\\$'));
  185.     call print(.('The letter "n" above must be a digit (i.e., $'));
  186.     call print(.('between 0 and 9).  If the disk\$'));
  187.     call print(.('specification is omitted, there will be no default $'));
  188.     call print(.('disk.\\$'));
  189. end diskhelp;
  190.  
  191. duplhelp:    procedure;
  192.     call print(.('\SET DUPLEX\\$'));
  193.     call print(.('  The DUPLEX option of the SET command controls $'));
  194.     call print(.('the display at the local\$'));
  195.     call print(.('system of characters entered during CONNECT mode.\\$'));
  196.     call print(.('Syntax:\\$'));
  197.     call print(.('    SET DUPLEX [FULL/HALF]\\$'));
  198.     call print(.('Use FULL when the remote system echoes the $'));
  199.     call print(.('characters you type.  Use HALF\$'));
  200.     call print(.('to get the local Kermit to echo them.  Half duplex $'));
  201.     call print(.('is also called "local echo".\\$'));
  202. end duplhelp;
  203.  
  204. eschelp:    procedure;
  205.     call print(.('\SET ESCAPE\\$'));
  206.     call print(.('  The ESCAPE option of the SET command is used $'));
  207.     call print(.('to change the escape character\$'));
  208.     call print(.('for CONNECT mode.\\$'));
  209.     call print(.('Syntax:\\$'));
  210.     call print(.('    SET ESCAPE [octal_value]\\$'));
  211.     call print(.('If the new value is not entered with the command, $'));
  212.     call print(.('you will be prompted for the\$'));
  213.     call print(.('new escape character, which you enter literally.\\$'));
  214. end eschelp;
  215.  
  216. parhelp:    procedure;
  217.     call print(.('\SET PARITY\\$'));
  218.     call print(.('  The PARITY option of the SET command is used $'));
  219.     call print(.('to set the communication\$'));
  220.     call print(.('parity.\\$'));
  221.     call print(.('Syntax:\\$'));
  222.     call print(.('    SET PARITY parity\\$'));
  223.     call print(.('Legal values for "parity" are NONE, MARK, SPACE, $'));
  224.     call print(.('EVEN, and NONE.\\$'));
  225. end parhelp;
  226.  
  227. porthelp:    procedure;
  228.     call print(.('\SET PORT\\$'));
  229.     call print(.('  The PORT option of the SET command is used $'));
  230.     call print(.('to change the I/O port.\\$'));
  231.     call print(.('Syntax:\\$'));
  232.     call print(.('    SET PORT port#\\$'));
  233.     call print(.('Permitted values for "port#" are 1 and 2.\\$'));
  234. end porthelp;
  235.  
  236. promhelp:    procedure;
  237.     call print(.('\SET PROMPT\\$'));
  238.     call print(.('  The PROMPT option of the SET command is used $'));
  239.     call print(.('to specify the Kermit command prompt.\\$'));
  240.     call print(.('Syntax:\\$'));
  241.     call print(.('    SET PROMPT [prompt-string]\\$'));
  242.     call print(.('The prompt string is limited to 20 characters.  $'));
  243.     call print(.('If no prompt string is entered,\$'));
  244.     call print(.('the prompt is reset to the original value, "$'));
  245.     call print(.def$prompt);
  246.     call print(.('".\\$'));
  247. end promhelp;
  248.  
  249. rethelp:    procedure;
  250.     call print(.('\SET RETRY\\$'));
  251.     call print(.('  The RETRY option of the SET command is used $'));
  252.     call print(.('to change the number of\$'));
  253.     call print(.('times that Kermit will retry packet transmission $'));
  254.     call print(.('before giving up.\\$'));
  255.     call print(.('Syntax:\\$'));
  256.     call print(.('    SET RETRY n\\$'));
  257.     call print(.('Permitted values for "n" are 1 through 255.\\$'));
  258. end rethelp;
  259.  
  260. takehelp:    procedure;
  261.     call print(.('\SET TAKE-ECHO\\$'));
  262.     call print(.('  The TAKE-ECHO option of the SET command is used $'));
  263.     call print(.('to control the display\$'));
  264.     call print(.('of commands read from the "TAKE" file.\\$'));
  265.     call print(.('Syntax:\\$'));
  266.     call print(.('    SET TAKE-ECHO [ON/OFF]\\$'));
  267.     call print(.('"SET TAKE-ECHO ON" will cause commands read $'));
  268.     call print(.('from the "TAKE" file to be\$'));
  269.     call print(.('displayed on the console.\\$'));
  270. end takehelp;
  271.  
  272. warnhelp:    procedure;
  273.     call print(.('\SET WARNING\\$'));
  274.     call print(.('  The WARNING option of the SET command is used $'));
  275.     call print(.('to control the handling\$'));
  276.     call print(.('of local file name conflicts.\\$'));
  277.     call print(.('Syntax:\\$'));
  278.     call print(.('    SET WARNING [ON/OFF]\\$'));
  279.     call print(.('"SET WARNING ON" will cause a warning message $'));
  280.     call print(.('to be issued when an incoming\$'));
  281.     call print(.('file has the same name as an existing local file.  $'));
  282.     call print(.('Kermit will then rename the\$'));
  283.     call print(.('incoming file.  "SET WARNING OFF" will cause Kermit $'));
  284.     call print(.('to overwrite the existing\$'));
  285.     call print(.('file.\\$'));
  286. end warnhelp;
  287.  
  288. /* Display help for the SET command */
  289. sethelp:procedure public;
  290.     tokptr = token;
  291.     if tokptr = 0 then call set$gen$help;
  292.     else
  293.       do;
  294.         call upcase(tokptr); /* Convert to uppercase */
  295.         if (varcmp(tokptr,.('ALL',null)) >= 1) then
  296.           do;
  297.             call baudhelp;
  298.             call pause;
  299.             call debhelp;
  300.             call pause;
  301.             call diskhelp;
  302.             call pause;
  303.             call duplhelp;
  304.             call pause;
  305.             call eschelp;
  306.             call pause;
  307.             call parhelp;
  308.             call pause;
  309.             call porthelp;
  310.             call pause;
  311.             call promhelp;
  312.             call pause;
  313.             call rethelp;
  314.             call pause;
  315.             call takehelp;
  316.             call pause;
  317.             call warnhelp;
  318.           end;
  319.         else
  320.         if (varcmp(tokptr,.('BAUD-RATE',null)) >= 1) then call baudhelp;
  321.         else
  322.         if (varcmp(tokptr,.('DEBUGGING',null)) >= 2) then call debhelp;
  323.         else
  324.         if (varcmp(tokptr,.('DISK',null)) >= 2) then call diskhelp;
  325.         else
  326.         if (varcmp(tokptr,.('DUPLEX',null)) >= 2) then call duplhelp;
  327.         else
  328.         if (varcmp(tokptr,.('ESCAPE',null)) >= 1) then call eschelp;
  329.         else
  330.         if (varcmp(tokptr,.('PARITY',null)) >= 2) then call parhelp;
  331.         else
  332.         if (varcmp(tokptr,.('PORT',null)) >= 2) then call porthelp;
  333.         else
  334.         if (varcmp(tokptr,.('PROMPT',null)) >= 2) then call promhelp;
  335.         else
  336.         if (varcmp(tokptr,.('RETRY',null)) >= 1) then call rethelp;
  337.         else
  338.         if (varcmp(tokptr,.('TAKE-ECHO',null)) >= 1) then call takehelp;
  339.         else
  340.         if (varcmp(tokptr,.('WARNING',null)) >= 1) then call warnhelp;
  341.         else
  342.           do;
  343.             call badop;
  344.             call set$gen$help;
  345.           end;
  346.       end;
  347. end sethelp;
  348.  
  349. set:
  350.     procedure public;
  351.     declare newport byte;
  352.     declare newbaud address;
  353.     declare newtry address;
  354.     declare newesc byte;
  355.     declare offset byte;
  356.  
  357.     tokptr = token;
  358.     if tokptr = 0 then
  359.       do;
  360.         call missop;
  361.         subcmd = 0;
  362.       end;
  363.     else
  364.       do;
  365.         call upcase(tokptr); /* Convert to uppercase */
  366.         if (varcmp(tokptr,.('BAUD-RATE',null)) >= 1) then subcmd = 1;
  367.         else
  368.         if (varcmp(tokptr,.('DEBUGGING',null)) >= 2) then subcmd = 2;
  369.         else
  370.         if (varcmp(tokptr,.('DISK',null)) >= 2) then subcmd = 3;
  371.         else
  372.         if (varcmp(tokptr,.('DUPLEX',null)) >= 2) then subcmd = 4;
  373.         else
  374.         if (varcmp(tokptr,.('ESCAPE',null)) >= 1) then subcmd = 5;
  375.         else
  376.         if (varcmp(tokptr,.('PARITY',null)) >= 2) then subcmd = 6;
  377.         else
  378.         if (varcmp(tokptr,.('PORT',null)) >= 2) then subcmd = 7;
  379.         else
  380.         if (varcmp(tokptr,.('PROMPT',null)) >= 2) then subcmd = 8;
  381.         else
  382.         if (varcmp(tokptr,.('RETRY',null)) >= 1) then subcmd = 9;
  383.         else
  384.         if (varcmp(tokptr,.('TAKE-ECHO',null)) >= 1) then subcmd = 10;
  385.         else
  386.         if (varcmp(tokptr,.('WARNING',null)) >= 1) then subcmd = 11;
  387.         else
  388.           do;
  389.             call badop;
  390.             subcmd = 0;
  391.           end;
  392.       end;
  393.  
  394.     do case subcmd;
  395.       /* 0 = illegal subcommand */
  396.       do;
  397.         /* Error already reported */
  398.       end;
  399.  
  400.       /* 1 = BAUD-RATE subcommand */
  401.       do;
  402.         tokptr = token; /* Get the operand */
  403.         if tokptr = 0 then call missop;
  404.         else
  405.           do;
  406.             newbaud = nin(tokptr);
  407.             if (procbaud(newbaud) = true) then
  408.               call ioinit;
  409.             else
  410.               call print(.('Invalid baud rate value entered\$'));
  411.           end;
  412.       end;
  413.  
  414.       /* 2 = DEBUGGING subcommand */
  415.       do;
  416.         tokptr = token; /* Get the operand */
  417.         if tokptr = 0 then call missop;
  418.         else
  419.           do;
  420.             call upcase(tokptr); /* Convert to uppercase */
  421.             if (varcmp(tokptr,.('ON',null)) >= 2) then debug = true;
  422.             else
  423.             if (varcmp(tokptr,.('OFF',null)) >= 2) then debug = false;
  424.             else
  425.               call badop;
  426.           end;
  427.       end;
  428.  
  429.       /* 3 = DISK subcommand */
  430.       do;
  431.         tokptr = token; /* Get the operand */
  432.         if tokptr = 0 then def$drive(0) = null; /* reset to "no default" */
  433.         else do;
  434.           call upcase(tokptr); /* Convert to uppercase */
  435.           if (new$drive(0) >= '0' and new$drive(0) <= '9' and
  436.               new$drive(1) = null) then
  437.             do; /* User entered a single digit */
  438.               call move(5,.(':F0:',null),.def$drive);
  439.               def$drive(2) = new$drive(0);
  440.             end;
  441.           else
  442.           if (new$drive(0) = ':' and new$drive(1) = 'F' and
  443.               new$drive(2) >= '0' and new$drive(2) <= '9' and
  444.               new$drive(3) = ':' and new$drive(4) = null) then
  445.             /* User entered a full drive specification */
  446.             call move(4,tokptr,.def$drive);
  447.           else
  448.             call badop;
  449.         end;
  450.       end;
  451.  
  452.       /* 4 = DUPLEX subcommand */
  453.       do;
  454.         tokptr = token; /* Get the operand */
  455.         if tokptr = 0 then call missop;
  456.         else
  457.           do;
  458.             call upcase(tokptr); /* Convert to uppercase */
  459.             if (varcmp(tokptr,.('HALF',null)) >= 1) then halfduplex = true;
  460.             else
  461.             if (varcmp(tokptr,.('FULL',null)) >= 1) then halfduplex = false;
  462.             else
  463.               call badop;
  464.           end;
  465.       end;
  466.  
  467.       /* 5 = ESCAPE subcommand */
  468.       do;
  469.         tokptr = token; /* Get the operand */
  470.         if tokptr <> 0 then
  471.           do; /* escape character value entered */
  472.             newesc = onin(tokptr); /* capture as octal value */
  473.             if (newesc > 0 and newesc <= 255) then escchar = newesc;
  474.             else
  475.                 call print(.('Invalid escape character value entered\$'));
  476.           end;
  477.         else
  478.           do; /* no value entered */
  479.             call print(.('Enter new escape character: $'));
  480.             escchar = getc(0); /* read from console */
  481.             call newline;
  482.           end;
  483.       end;
  484.  
  485.       /* 6 = PARITY subcommand */
  486.       do;
  487.         tokptr = token; /* Get the operand */
  488.         if tokptr = 0 then call missop;
  489.         else
  490.           do;
  491.             call upcase(tokptr); /* Convert to uppercase */
  492.             if (varcmp(tokptr,.('NONE',null)) >= 1) then parity = 0;
  493.             else
  494.             if (varcmp(tokptr,.('MARK',null)) >= 1) then parity = 1;
  495.             else
  496.             if (varcmp(tokptr,.('SPACE',null)) >= 1) then parity = 2;
  497.             else
  498.             if (varcmp(tokptr,.('EVEN',null)) >= 1) then parity = 3;
  499.             else
  500.             if (varcmp(tokptr,.('ODD',null)) >= 1) then parity = 4;
  501.             else
  502.               call badop;
  503.             call ioinit;
  504.           end;
  505.       end;
  506.  
  507.       /* 7 = PORT subcommand */
  508.       do;
  509.         tokptr = token; /* Get the operand */
  510.         if tokptr = 0 then call missop;
  511.         else
  512.           do;
  513.             newport = nin(tokptr);
  514.             if (newport = 1 or newport = 2) then
  515.               do;
  516.                 port = newport;
  517.                 call ioinit;
  518.               end;
  519.             else
  520.               call print(.('Invalid port value entered\$'));
  521.           end;
  522.       end;
  523.  
  524.       /* 8 = PROMPT subcommand */
  525.       do;
  526.         tokptr = cmdtail; /* Get the rest of the command line */
  527.         if tokptr = 0 then offset = movevar(0,.def$prompt,.prompt);
  528.         else offset = movevar(0,tokptr,.prompt);
  529.       end;
  530.  
  531.       /* 9 = RETRY subcommand */
  532.       do;
  533.         tokptr = token; /* Get the operand */
  534.         if tokptr = 0 then call missop;
  535.         else
  536.           do;
  537.             newtry = nin(tokptr);
  538.             if (newtry >  0 and newtry < 256) then maxtry = newtry;
  539.             else
  540.               call print(.('Invalid retry value entered$\'));
  541.           end;
  542.       end;
  543.  
  544.       /* 10 = TAKE-ECHO subcommand */
  545.       do;
  546.         tokptr = token; /* Get the operand */
  547.         if tokptr = 0 then call missop;
  548.         else
  549.           do;
  550.             call upcase(tokptr); /* Convert to uppercase */
  551.             if (varcmp(tokptr,.('ON',null)) >= 2) then take$echo = true;
  552.             else
  553.             if (varcmp(tokptr,.('OFF',null)) >= 2) then take$echo = false;
  554.             else
  555.               call badop;
  556.           end;
  557.       end;
  558.  
  559.       /* 11 = WARNING subcommand */
  560.       do;
  561.         tokptr = token; /* Get the operand */
  562.         if tokptr = 0 then call missop;
  563.         else
  564.           do;
  565.             call upcase(tokptr); /* Convert to uppercase */
  566.             if (varcmp(tokptr,.('ON',null)) >= 2) then warning$flag = true;
  567.             else
  568.             if (varcmp(tokptr,.('OFF',null)) >= 2) then warning$flag = false;
  569.             else
  570.               call badop;
  571.           end;
  572.       end;
  573.  
  574.     end;
  575. end set;
  576.  
  577. end set$module;
  578.