?? RIGHT := 110 ??
MODULE sym$core_command_utilities;


{
{  PURPOSE:
{     This module is a collection of utility procs used by the sys core
{     command processor.
{

?? PUSH (LISTEXT := ON) ??
*copyc SYT$VALUE_KINDS
*copyc SYE$COMMAND_PROCESSOR_ERRORS
*copyc OSD$VIRTUAL_ADDRESS
*copyc OSS$MAINFRAME_PAGED_LITERAL
?? POP ??
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc osp$append_status_integer
*copyc ocp$find_debug_entry_point

  VAR
    non_space: [STATIC, READ, oss$mainframe_paged_literal] packed array [char] of boolean := [
{---} REP 9 of TRUE,
{HT } FALSE,
{---} REP 22 of TRUE,
{- -} FALSE,
{---} REP 223 of TRUE],
    comment_delimiter: [STATIC, READ, oss$mainframe_paged_literal] packed array [char] of boolean := [
{---} REP 34 of FALSE,
{ " } TRUE,
{---} REP 221 of FALSE];

?? TITLE := 'SYP$ASCII_TO_BINARY', EJECT ??
{-----------------------------------------------------------------------------------------------
{This procedure converts an ASCII string to an integer. A default base can be specified but
{may be overriden by an explicit declaration of a base in the string. The string
{may start with a - to indicate a negative number. Strings of the following formats are supported:
{   nnn
{  -nnn
{   nnn(bb)
{  -nnn(bb)
{       where nnn and bb are strings of one or more digits.
{-----------------------------------------------------------------------------------------------

  PROCEDURE [XDCL] syp$ascii_to_binary (text: string ( * );
        default_base: 1 .. 16;
    VAR int: integer;
    VAR status: ost$status);

    VAR
      negative: boolean,
      ch: char,
      i: 0 .. 255,
      k,
      base: integer,
      len: integer;


    status.normal := TRUE;
    int := 0;
    len := STRLENGTH (text);
    IF len = 0 THEN
      RETURN
    IFEND;

    IF text (len) <> ')' THEN
      base := default_base;
    ELSE
      i := 1;
      WHILE text (i) <> '(' DO
        i := i + 1;
        IF i = len THEN
          osp$set_status_abnormal ('SY', sye$invalid_character, 'Invalid radix specification', status);
          RETURN;
        IFEND;
      WHILEND;
      syp$ascii_to_binary (text (i + 1, len - i - 1), 10, base, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      len := i - 1;
    IFEND;

    negative := text (1) = '-';
    IF negative THEN
      i := 2;
    ELSE
      i := 1;
    IFEND;

    WHILE i <= len DO
      ch := text (i);
      k := ORD (ch) - ORD ('0');
      IF (k > 9) OR (k < 0) THEN
        k := ORD (ch) - ORD ('A') + 10;
        IF k >= base THEN
          k := k - 32;
        IFEND;
      IFEND;
      IF (k < 0) OR (k >= base) THEN
        osp$set_status_abnormal ('SY', sye$invalid_character, 'Invalid digit', status);
        RETURN;
      IFEND;
      int := int * base + k;
      i := i + 1;
    WHILEND;
    IF negative THEN
      int := - int;
    IFEND;

  PROCEND syp$ascii_to_binary;
?? TITLE := 'SYP$BINARY_TO_ASCII', EJECT ??
{-----------------------------------------------------------------------------------------------
{This procedure is used to convert a binary number to its ASCII representation. Input parameters are:
{  I : number to be converted.
{  pos : rightmost char position for the converted string.
{        Leading zeroes on the string are not stored by this
{        routine.
{  base: base for ascii conversion (ie., 10 or 16 for decimal or hex
{-----------------------------------------------------------------------------------------------

  PROCEDURE [XDCL] syp$binary_to_ascii (i: integer;
    VAR st: string ( * );
        base: 2 .. 16;
        pos: 1 .. 255);

    VAR
      k,
      l: integer,
      negative: boolean,
      p: 0 .. 255;

    k := i;
    p := pos;
    negative := k < 0;
    IF negative THEN
      k := - k;
    IFEND;


    REPEAT
      l := k MOD base;
      IF l <= 9 THEN
        st (p) := CHR (l + ORD ('0'));
      ELSE
        st (p) := CHR (l - 10 + ORD ('A'));
      IFEND;
      k := k DIV base;
      p := p - 1;
    UNTIL (k = 0) OR (p = 0);
    IF negative AND (p > 0) THEN
      st (p) := '-';
    IFEND;

  PROCEND syp$binary_to_ascii;
?? TITLE := 'SYP$GET_TOKEN', EJECT ??
{-----------------------------------------------------------------------------------------------
{This procedure returns the next token from a line of text. Tokens may be separated by a comma and/or blanks.
{A null token is denoted by 2 commas separated with with zero OR more blanks. Strings are enclosed IN single
{quotes.
{-----------------------------------------------------------------------------------------------


  PROCEDURE [XDCL, #GATE] syp$get_token (text: string ( * );
        upper_case: boolean;
    VAR index: 0 .. 255;
    VAR token: ost$string;
    VAR status: ost$status);

    VAR
      lhi,
      rhi,
      scan_index: integer,
      found_char,
      commaflag: boolean,
      ch: char;


    status.normal := TRUE;
    commaflag := FALSE;
    lhi := index;
    rhi := STRLENGTH (text);
    token.size := 0;

  /build_token/
    BEGIN

    /find_start_of_token/
      WHILE TRUE DO

      /scan_loop/
        WHILE lhi <= rhi DO
          #scan (non_space, text (lhi, * ), scan_index, found_char);
          lhi := scan_index + lhi - 1;
          IF found_char AND (text (lhi) = '"') THEN
            #scan (comment_delimiter, text (lhi + 1, * ), scan_index, found_char);
            lhi := scan_index + lhi + ORD (found_char);
          ELSEIF scan_index <= 1 THEN
            EXIT /scan_loop/;
          IFEND;
        WHILEND /scan_loop/;
        IF lhi > rhi THEN
          EXIT /build_token/
        IFEND;
        ch := text (lhi);
        IF ch <> ',' THEN
          EXIT /find_start_of_token/
        IFEND;
        IF commaflag THEN
          EXIT /build_token/
        IFEND;
        commaflag := TRUE;
        lhi := lhi + 1;
      WHILEND /find_start_of_token/;

      IF ch = '''' THEN
        token.value (1) := ch;
        token.size := 1;

        WHILE lhi < rhi DO
          lhi := lhi + 1;
          ch := text (lhi);
          IF token.size = STRLENGTH (token.value) THEN
            osp$set_status_abnormal ('sy', sye$syntax_error, 'Syntax error', status);
          ELSE
            token.size := token.size + 1;
            token.value (token.size) := ch;
          IFEND;
          IF ch = '''' THEN
            IF lhi = rhi THEN
              lhi := lhi + 1;
              EXIT /build_token/;
            IFEND;
            lhi := lhi + 1;
            ch := text (lhi);
            IF ch <> '''' THEN
              EXIT /build_token/;
            IFEND;
          ELSEIF lhi = rhi THEN
            osp$set_status_abnormal ('SY', sye$syntax_error, 'Unexpected end-of-line', status);
            EXIT /build_token/;
          IFEND;
        WHILEND;
      ELSE

        WHILE lhi <= rhi DO
          ch := text (lhi);
          IF (ch = '=') THEN
            osp$set_status_abnormal ('SY', sye$syntax_error, 'Unsupported keyword format', status);
          IFEND;
          IF (ch = ' ') OR (ch = ',') THEN
            EXIT /build_token/
          IFEND;
          IF token.size = STRLENGTH (token.value) THEN
            osp$set_status_abnormal ('SY', sye$token_too_long, 'Token is too long', status);
          ELSE
            token.size := token.size + 1;
            IF upper_case AND (ch >= 'a') AND (ch <= 'z') THEN
              ch := CHR (ORD (ch) - ORD ('a') + ORD ('A'));
            IFEND;
            token.value (token.size) := ch;
          IFEND;
          lhi := lhi + 1;
        WHILEND;
      IFEND;
    END /build_token/;

    index := lhi;

  PROCEND syp$get_token;

?? TITLE := 'SYP$CRACK_COMMAND', EJECT ??
{-----------------------------------------------------------------------------------------------
{This procedure cracks the parameters on a line of text and returns the values
{of the parameters in a Parameter Value Table. A description of the parameter
{attributes is supplied in a Parameter Value Table.
{-----------------------------------------------------------------------------------------------



  PROCEDURE [XDCL] syp$crack_command (pdt: array [1 .. * ] OF syt$parameter_descriptor;
        text: string ( * );
    VAR pvt: array [1 .. * ] OF syt$parameter_value;
    VAR status: ost$status);

    VAR
      pdt_p: ^syt$parameter_descriptor,
      pvt_p: ^syt$parameter_value,
      i: integer,
      token: ost$string,
      ch_index: 0 ..255,
      index: 0 .. 255,
      int: integer,
      ring: 0 .. 15,
      seg: ost$segment,
      found: boolean,
      module_name: pmt$program_name,
      program_name: pmt$program_name,
      offset: ost$segment_offset;

    status.normal := TRUE;
    index := 1;

    FOR i := 1 TO UPPERBOUND (pdt) DO
      pdt_p := ^pdt [i];
      pvt_p := ^pvt [i];
      IF pdt_p^.parameter_kind = syc$pointer_value THEN
        syp$get_token (text, FALSE {upper_case}, index, token, status);
      ELSE
        syp$get_token (text, TRUE {upper_case}, index, token, status);
      IFEND;
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF token.size = 0 THEN
        pvt_p^.defined := FALSE;
        IF pdt_p^.required THEN
          osp$set_status_abnormal ('SY', sye$missing_parameter, 'Missing parameter', status);
          RETURN;
        ELSE
          CASE pdt_p^.parameter_kind OF
          = syc$name_value =
            pvt_p^.name := pdt_p^.namedef;
          = syc$boolean_value =
            pvt_p^.bool := pdt_p^.bdefault;
          = syc$integer_value =
            pvt_p^.int := pdt_p^.idefault;
          = syc$string_value =
            pvt_p^.text := pdt_p^.text_default;
          = syc$pointer_value =
            pvt_p^.ptr := pdt_p^.ptr_default;
          ELSE
          CASEND;
        IFEND;
      ELSE

        pvt_p^.defined := TRUE;
        CASE pdt_p^.parameter_kind OF
        = syc$name_value =
          IF token.size > STRLENGTH (pvt_p^.name) THEN
            osp$set_status_abnormal ('SY', sye$token_too_long, 'Token is too long', status);
            RETURN;
          IFEND;
          pvt_p^.name := token.value (1, token.size);
        = syc$integer_value =
          syp$ascii_to_binary (token.value (1, token.size), 10, int, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          IF (int < pdt_p^.imin) OR (int > pdt_p^.imax) THEN
            osp$set_status_condition (sye$range_error, status);
            osp$append_status_integer (osc$status_parameter_delimiter, int, 10 {=radix}, FALSE, status);
            osp$append_status_integer (osc$status_parameter_delimiter, pdt_p^.imin, 10, FALSE, status);
            osp$append_status_integer (osc$status_parameter_delimiter, pdt_p^.imax, 10, FALSE, status);
            RETURN;
          ELSE
            pvt_p^.int := int;
          IFEND;
        = syc$string_value =
          IF (token.value (1) <> '''') OR (token.value (token.size) <> '''') THEN
            osp$set_status_abnormal ('SY', sye$syntax_error, 'Invalid string', status);
            RETURN;
          ELSE
            IF token.size > 2 THEN
              pvt_p^.text.value (1, token.size - 2) := token.value (2, token.size - 2);
            IFEND;
            pvt_p^.text.size := token.size - 2;
          IFEND;
        = syc$pointer_value =
          IF (token.value (1) >= '0') AND (token.value (1) <= '9') THEN
            syp$ascii_to_binary (token.value (1, token.size), 16, int, status);
            ring := int DIV 100000000000(16);
            seg := (int - ring * 100000000000(16)) DIV 100000000(16);
            offset := int MOD 80000000(16);
          ELSE
            program_name := token.value (1, token.size);
            ocp$find_debug_entry_point (program_name, found, module_name, seg, offset, status);
            IF NOT found THEN

{  Convert to upper case and try again.

              FOR ch_index := 1 TO token.size DO
                IF (token.value (ch_index) >= 'a') AND (token.value (ch_index) <= 'z') THEN
                  token.value (ch_index) := CHR (ORD (token.value (ch_index)) - ORD ('a') + ORD ('A'));
                IFEND;
              FOREND;
              program_name := token.value (1, token.size);
              ocp$find_debug_entry_point (program_name, found, module_name, seg, offset, status);
              IF NOT found THEN
                osp$set_status_abnormal ('SY', sye$invalid_character, 'Entry point not found', status);
              IFEND;
            IFEND;
            ring := 1;
          IFEND;
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          IF ring = 0 THEN
            ring := 1;
          IFEND;
          pvt_p^.ptr := #address (ring, seg, offset);
        = syc$boolean_value =
          pvt_p^.bool := (token.value (1, 2) = 'ON') OR (token.value (1, 4) = 'TRUE') OR (token.value (1, 3) =
            'YES');
          IF NOT pvt_p^.bool AND NOT ((token.value (1, 3) = 'OFF') OR (token.value (1, 5) = 'FALSE') OR
                (token.value (1, 2) = 'NO')) THEN
            osp$set_status_abnormal ('SY', sye$syntax_error, 'Unknown value for boolean', status);
            RETURN;
          IFEND;
        ELSE
          osp$set_status_abnormal ('SY', sye$bad_pdt, 'Bad PDT', status);
          RETURN;
        CASEND;
      IFEND;
    FOREND;

  PROCEND syp$crack_command;

MODEND sym$core_command_utilities;
