?? RIGHT := 110, LEFT := 1 ??
?? FMT (FORMAT := ON, keyw := upper, ident := lower) ??
MODULE sym$misc_services_1ff;

{
{  PURPOSE:
{     This module contains miscellaneous System Core requests which
{     must be run at the ring of the caller.
{

?? PUSH (LISTEXT := ON) ??
*copyc MLT$ERROR
*copyc MLT$FLOATING_LENGTH
*copyc MLT$OUTPUT_FORMAT
*copyc MLT$STRING_LENGTH
*copyc OST$HARDWARE_SUBRANGES
*copyc OSS$MAINFRAME_PAGED_LITERAL
*copyc OSP$SYSTEM_ERROR

?? POP ??
?? SKIP := 4 ??
?? TITLE := '[XDCL, #GATE] pmp$zero_out_table' ??
{-----------------------------------------------------------------------------------------------------
{Name
{  pmp$zero_out_table
{Purpose
{  This routine can be called to zero out a block of storage.
{-------------------------------------------------------------------------------------------------------


  PROCEDURE [XDCL, #GATE] pmp$zero_out_table (p: ^cell;
        len: ost$byte_count);

    VAR
      zeros: [STATIC, READ, oss$mainframe_paged_literal] record
        case b: 0 .. 1 of
        = 0 =
          a: array [0 .. 31] of integer,
        = 1 =
          s: string (248),
        casend,
      recend := [0, [REP 32 of 0]],
      sp: record
        case b: 0 .. 1 of
        = 0 =
          p: ^string (248),
        = 1 =
          ringseg: 0 .. 0ffff(16),
          bytenum: ost$byte_count,
        casend,
      recend,
      sl: integer;

    sp.p := #LOC (p^);
    sl := len;
    WHILE sl >= 248 DO
      sp.p^ := zeros.s;
      sl := sl - 248;
      sp.bytenum := sp.bytenum + 248;
    WHILEND;
    IF sl > 0 THEN
      sp.p^ (1, sl) := zeros.s (1, sl);
    IFEND;

  PROCEND pmp$zero_out_table;
?? TITLE := ' [XDCL, #GATE] pmp$binary_to_ascii' , EJECT ??
?? FMT (FORMAT := OFF) ??
{--------------------------------------------------------------------------------------------------------
{Name:
{  pmp$binary_to_ascii
{Purpose:
{  Convert a binary number to its ASCII representation.
{Input:
{  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
{Output:
{  st : string is updated with the ascii value of the string.
{--------------------------------------------------------------------------------------------------------
?? FMT (FORMAT := ON) ??

  PROCEDURE [XDCL, #GATE] pmp$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 pmp$binary_to_ascii;
?? TITLE, ' [XDCL, #GATE] pmp$binary_to_ascii_fit', EJECT ??
{--------------------------------------------------------------------------------------------------------
{ Name:
{   pmp$binary_to_ascii_fit
{ Purpose:
{   Convert a binary number to its ASCII representation.
{ Input:
{   int: number to be converted.
{   base: base for ascii conversion (ie., 10 or 16 for decimal or hex)
{   pos : rightmost char position for the converted string.
{         Leading zeroes on the string are not stored by this
{         routine.
{   length: maximum length of the string to be returned.
{ Output:
{   str: string is updated with the ascii value of the number.
{--------------------------------------------------------------------------------------------------------

  PROCEDURE [XDCL, #GATE] pmp$binary_to_ascii_fit
    (    int: integer;
         base: 2 .. 16;
         pos: 1 .. 255;
         length: 1 .. 255;
     VAR str: string ( * ));

    CONST
      k_pos = 253,
      max_length = 255;

    VAR
      digit: integer,
      exp: 0 .. 99,
      e_pos: 1 .. 255,
      negative: boolean,
      next_pos: 0 .. 255,
      number: integer,
      overflow: 1 .. 255,
      str_length: 1 .. 255,
      temp_str: string (255);


    next_pos := max_length;
    temp_str := ' ';
    number := int;
    negative := number < 0;
    IF negative THEN
      number := -number;
    IFEND;

    REPEAT
      digit := number MOD base;
      IF digit <= 9 THEN
        temp_str (next_pos) := CHR (digit + ORD ('0'));
      ELSE
        temp_str (next_pos) := CHR (digit - 10 + ORD ('A'));
      IFEND;
      number := number DIV base;
      next_pos := next_pos - 1;
    UNTIL (number = 0);

    IF negative THEN
      temp_str (next_pos) := '-';
      next_pos := next_pos - 1;
    IFEND;

    str_length := max_length - next_pos;
    IF str_length > length THEN
      overflow := str_length - length;
      str_length := length;
      IF  overflow <= 2 THEN
        temp_str (k_pos, 1) := 'K';
        IF overflow = 1 THEN
          str_length := str_length - 1;
        IFEND;
      ELSEIF overflow <= 7 THEN
        e_pos := next_pos + length - 1;
        exp := overflow + 2;
        temp_str (e_pos, 1) := 'E';
        temp_str (e_pos + 1, 1) := CHR (exp + ORD ('0'));
      ELSE
        e_pos := next_pos + length - 2;
        exp := overflow + 3;
        temp_str (e_pos, 1) := 'E';
        temp_str (e_pos + 2, 1) := CHR ((exp MOD 10) + ORD ('0'));
        temp_str (e_pos + 1, 1) := CHR ((exp DIV 10) + ORD ('0'));
      IFEND;
    IFEND;

    str (pos - str_length + 1, str_length) := temp_str (next_pos + 1, str_length);

  PROCEND pmp$binary_to_ascii_fit;

MODEND sym$misc_services_1ff;
