

?? PUSH (LISTEXT := ON) ??
*copyc i#move
*copyc osp$format_message
*copyc pmp$log_ascii
*copyc oss$job_paged_literal
?? POP ??

  PROCEDURE log_display
    (    logset: pmt$ascii_logset;
         display_line: string ( * <= 255));

    VAR
      length: integer,
      working_string: string (256),
      ignore_status: ost$status;

    STRINGREP (working_string, length, ' ', display_line);
    pmp$log_ascii (working_string (1, length), logset, pmc$msg_origin_system,
          ignore_status);
  PROCEND log_display;
?? SKIP := 5 ??

  PROCEDURE log_display_boolean
    (    logset: pmt$ascii_logset;
         descriptor: string ( * <= 128);
         value: boolean);

    VAR
      total_length: integer,
      working_string: string (150);

    STRINGREP (working_string, total_length, descriptor, ' ', value);
    log_display (logset, working_string (1, total_length));

  PROCEND log_display_boolean;
?? SKIP := 5 ??

  PROCEDURE log_display_bytes
    (    logset: pmt$ascii_logset;
         address: ^cell;
         length: integer);

    VAR
      hex_digits: [STATIC, oss$job_paged_literal, READ] array [0 .. 15] of
            char := ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a',
            'b', 'c', 'd', 'e', 'f'];

    VAR
      data: ^string ( * ),
      data_index: integer,
      line: string (72),
      line_index: integer;

    line_index := 1;
    PUSH data: [length];
    i#move (address, data, length);
    line := ' ';
    FOR data_index := 1 TO length DO
      line (line_index) := hex_digits [$INTEGER (data^ (data_index)) DIV 16];
      line (line_index + 1) := hex_digits [$INTEGER (data^ (data_index)) MOD
            16];
      IF (data_index MOD 8) = 0 THEN
        line (line_index + 2) := ' ';
        line_index := line_index + 1;
      IFEND;
      line_index := line_index + 2;
      IF (line_index > 67) OR (data_index = length) THEN
        log_display (logset, line (1, (line_index - 1)));
        line := ' ';
        line_index := 1;
      IFEND;
    FOREND;
  PROCEND log_display_bytes;
?? SKIP := 5 ??

  PROCEDURE log_display_integer
    (    logset: pmt$ascii_logset;
         descriptor: string ( * <= 127);
         number: integer);

    VAR
      descriptor_length: integer,
      number_length: integer,
      total_length: integer,
      working_string: string (150);

    working_string := descriptor;
    descriptor_length := STRLENGTH (descriptor);
    STRINGREP (working_string ((descriptor_length + 2), * ), number_length,
          number);
    total_length := number_length + descriptor_length + 2;
    log_display (logset, working_string (1, total_length));
  PROCEND log_display_integer;
?? SKIP := 5 ??

  PROCEDURE log_display_pva
    (    logset: pmt$ascii_logset;
         descriptor: string ( * <= 127);
         pva: ^cell);

    VAR
      descriptor_length: integer,
      length: integer,
      working_string: string (150);

    STRINGREP (working_string, length, descriptor, ' ', pva);
    log_display (logset, working_string (1, length));
  PROCEND log_display_pva;
?? SKIP := 5 ??

  PROCEDURE log_display_real
    (    logset: pmt$ascii_logset;
         descriptor: string ( * );
         number: real);

    VAR
      descriptor_length: integer,
      length: integer,
      working_string: string (150);

    STRINGREP (working_string, length, ' ', descriptor, ' ', number);
    log_display (logset, working_string (1, length));
  PROCEND log_display_real;
?? SKIP := 5 ??

  PROCEDURE log_display_status
    (    logset: pmt$ascii_logset;
         format: boolean;
         status: ost$status);

    VAR
      line_count: ost$status_message_line_count,
      message: ost$status_message,
      p_line_count: ^ost$status_message_line_count,
      p_line_size: ^ost$status_message_line_size,
      p_message: ^ost$status_message,
      p_message_line: ^string ( * ),
      request_status: ost$status;

    request_status.normal := TRUE;
    IF status.normal THEN
      log_display (logset, ' STATUS NORMAL ');
      RETURN;
    ELSE
      log_display (logset, ' STATUS abnormal');
      log_display_integer (logset, ' condition ', status.condition);
      log_display (logset, status.text.value (1, status.text.size));
    IFEND;
    IF NOT format THEN
      RETURN;
    IFEND;
    p_message := ^message;
    RESET p_message;
    osp$format_message (status, osc$full_message_level, osc$max_string_size,
          p_message^, request_status);
    IF NOT request_status.normal THEN
      log_display (logset, ' unable to display status ');
      RETURN;
    IFEND;
    RESET p_message;
    NEXT p_line_count IN p_message;
    IF p_line_count^ > 0 THEN
      FOR line_count := 1 TO (p_line_count^) DO
        NEXT p_line_size IN p_message;
        NEXT p_message_line: [p_line_size^] IN p_message;
        log_display (logset, p_message_line^);
      FOREND;
    IFEND;
  PROCEND log_display_status;

?? SKIP := 5 ??

  PROCEDURE log_display_trace_back
    (    logset: pmt$ascii_logset);

    TYPE
      sfsa_type = record
        fill1: 0 .. 0ffff(16),
        p: ^cell,
        a0: integer,
        a1: integer,
        fill2: 0 .. 0ffff(16),
        a2: ^sfsa_type, {previous save area pointer}
      recend;

    VAR
      length: integer,
      message: string (80),
      stack: integer,
      sfsa_p: ^sfsa_type; {pointer to previous stack frame save area}

    ;

    sfsa_p := #PREVIOUS_SAVE_AREA ();

  /display_calls/
    FOR stack := 0 TO 20 DO
      STRINGREP (message, length, ' Stack ', stack, ' P= ', sfsa_p^.p);
      log_display (logset, message (1, length));
      sfsa_p := sfsa_p^.a2; { move to next previous sfsa }
      IF sfsa_p = NIL THEN
        EXIT /display_calls/;
      IFEND;
    FOREND /display_calls/;
  PROCEND log_display_trace_back;
?? SKIP := 5 ??

  PROCEDURE log_display_unformatted_status
    (    logset: pmt$ascii_logset;
         status: ost$status);

    IF status.normal THEN
      log_display (logset, ' STATUS NORMAL ');
    ELSE
      log_display (logset, ' STATUS abnormal');
      log_display_integer (logset, ' condition ', status.condition);
      log_display (logset, status.text.value (1, status.text.size));
    IFEND;
  PROCEND log_display_unformatted_status;

