?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Work Area Manager' ??
MODULE clm$work_area_manager;

{
{ PURPOSE:
{   This module manages the task local work areas used by various SCL services.
{   Each task has, potentially, one work area per ring (3..13).  If a request
{   is made from ring 2, ring 3's work area is used.  Each work area is created
{   as a segment the first time it is needed.  The segment is used as a stack
{   to permit nested usages.  The stack is controlled by a sequence pointer
{   which is the first item of data in the segment.  The pointer is initialized
{   once the segment has been created.  Users of the work area manipulate this
{   pointer DIRECTLY to keep track of how much of the area they have used.
{   When a user obtains a pointer to a work area, its "current position" must
{   be treated as the beginning of the sequence, i.e. the user must NEVER use
{   any part of the sequence "behind" that point.
{
{ NOTE:
{   The maximum segment length for a work area is set to clv$work_area_size,
{   however the sequence pointer's size component is set to the maximum
{   possible value.  This is done so that attempts to access the work area
{   beyond its maximum segment length will always be "translated" to the
{   mmc$sac_read_write_beyond_msl segment access condition.  It also eliminates
{   the need to check for NIL after doing a NEXT in the work area.
{

?? NEWTITLE := 'Global Declarations' ??
?? NEWTITLE := 'clt$saved_work_area_positions', EJECT ??
*copyc clt$saved_work_area_positions
?? TITLE := 'clt$work_areas', EJECT ??
*copyc clt$work_areas
?? OLDTITLE, EJECT ??
?? PUSH (LISTEXT := ON) ??
*IF $true(osv$unix)
*copyc cle$work_area_overflow
*IFEND
*copyc oss$task_private
*copyc oss$task_shared
*copyc ost$caller_identifier
?? POP ??
*copyc mmp$create_segment
*IF $true(osv$unix)
*copyc osp$set_status_abnormal
*IFEND
?? EJECT ??

  VAR
    clv$work_areas: [XDCL, #GATE, oss$task_private] clt$work_areas :=
*IF NOT $true(osv$unix)
          [REP osc$user_ring_2 - osc$tsrv_ring + 1 of [1, NIL]];
*ELSE
          [1, NIL]
          ;
*IFEND

  VAR
*IF NOT $true(osv$unix)
    clv$work_area_size: [XDCL, oss$task_shared] ost$segment_length := 10000000(16);
*ELSE
    clv$work_area_size: [XDCL, oss$task_shared] ost$segment_length := 100000(16);
*IFEND

?? TITLE := 'clp$get_work_area', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$get_work_area
    (    work_area_ring: ost$valid_ring;
     VAR work_area: ^^clt$work_area;
     VAR status: ost$status);

*IF NOT $true(osv$unix)

    VAR
      caller_id: ost$caller_identifier,
      segment_attributes: array [1 .. 2] of mmt$attribute_descriptor,
      segment_pointer: mmt$segment_pointer;

*ELSE

    VAR
      new_work_area: ^clt$work_area;

*IFEND


    status.normal := TRUE;
    work_area := NIL;

*IF NOT $true(osv$unix)

    #CALLER_ID (caller_id);
    IF work_area_ring > caller_id.ring THEN
      caller_id.ring := work_area_ring;
    IFEND;
    IF caller_id.ring < osc$tsrv_ring THEN
      caller_id.ring := osc$tsrv_ring;
    ELSEIF caller_id.ring > osc$user_ring_2 THEN
      caller_id.ring := osc$user_ring_2;
    IFEND;

    IF clv$work_areas [caller_id.ring].pointer = NIL THEN
      segment_attributes [1].keyword := mmc$kw_max_segment_length;
      segment_attributes [1].max_length := clv$work_area_size;
      segment_attributes [2].keyword := mmc$kw_ring_numbers;
      segment_attributes [2].r1 := caller_id.ring;
      segment_attributes [2].r2 := osc$user_ring_2;
      mmp$create_segment (^segment_attributes, mmc$sequence_pointer, caller_id.ring, segment_pointer, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      RESET segment_pointer.seq_pointer;
      NEXT clv$work_areas [caller_id.ring].pointer IN segment_pointer.seq_pointer;
      clv$work_areas [caller_id.ring].pointer^ := segment_pointer.seq_pointer;
      clv$work_areas [caller_id.ring].breakdown^.length := UPPERVALUE (clv$work_areas [caller_id.ring].
            breakdown^.length);
    IFEND;

    work_area := clv$work_areas [caller_id.ring].pointer;

*ELSE

    IF clv$work_areas.pointer = NIL THEN
      ALLOCATE new_work_area: [[REP clv$work_area_size OF cell]];
      IF new_work_area = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, 'clp$get_work_area', status);
        RETURN;
      IFEND;
      RESET new_work_area;
      NEXT clv$work_areas.pointer IN new_work_area;
      clv$work_areas.pointer^ := new_work_area;
    IFEND;

    work_area := clv$work_areas.pointer;

*IFEND

  PROCEND clp$get_work_area;
?? TITLE := 'clp$save_work_area_positions', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$save_work_area_positions
    (VAR saved_work_area_positions: clt$saved_work_area_positions);

*IF NOT $true(osv$unix)

    VAR
      ring: osc$tsrv_ring .. osc$user_ring_2;


    FOR ring := osc$tsrv_ring TO osc$user_ring_2 DO
      IF clv$work_areas [ring].breakdown = NIL THEN
        saved_work_area_positions [ring] := 0;
      ELSE
        saved_work_area_positions [ring] := clv$work_areas [ring].breakdown^.nextt;
      IFEND;
    FOREND;

*ELSE

    IF clv$work_areas.breakdown = NIL THEN
      saved_work_area_positions := 0;
    ELSE
      saved_work_area_positions := clv$work_areas.breakdown^.nextt;
    IFEND;

*IFEND

  PROCEND clp$save_work_area_positions;
?? TITLE := 'clp$restore_work_area_positions', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$restore_work_area_positions
    (    saved_work_area_positions: clt$saved_work_area_positions;
     VAR status: ost$status);

*IF NOT $true(osv$unix)

    VAR
      ring: osc$tsrv_ring .. osc$user_ring_2;


    status.normal := TRUE;
    FOR ring := osc$tsrv_ring TO osc$user_ring_2 DO
      IF clv$work_areas [ring].breakdown <> NIL THEN
        IF saved_work_area_positions [ring] = 0 THEN
          clv$work_areas [ring].breakdown^.nextt := #SIZE (cyt$sequence_pointer);
        ELSE
          clv$work_areas [ring].breakdown^.nextt := saved_work_area_positions [ring];
        IFEND;
      IFEND;
    FOREND;

*ELSE

    status.normal := TRUE;
    IF clv$work_areas.breakdown <> NIL THEN
      IF saved_work_area_positions = 0 THEN
        clv$work_areas.breakdown^.nextt := #SIZE (cyt$sequence_pointer);
      ELSE
        clv$work_areas.breakdown^.nextt := saved_work_area_positions;
      IFEND;
    IFEND;

*IFEND

  PROCEND clp$restore_work_area_positions;
?? TITLE := 'clp$reset_work_area_positions', EJECT ??

  PROCEDURE [XDCL] clp$reset_work_area_positions
    (VAR status: ost$status);

*IF NOT $true(osv$unix)

    VAR
      ring: osc$tsrv_ring .. osc$user_ring_2;


    status.normal := TRUE;
    FOR ring := osc$tsrv_ring TO osc$user_ring_2 DO
      IF clv$work_areas [ring].breakdown <> NIL THEN
        clv$work_areas [ring].breakdown^.nextt := #SIZE (cyt$sequence_pointer);
      IFEND;
    FOREND;

*ELSE

    status.normal := TRUE;
    IF clv$work_areas.breakdown <> NIL THEN
      clv$work_areas.breakdown^.nextt := #SIZE (cyt$sequence_pointer);
    IFEND;

*IFEND

  PROCEND clp$reset_work_area_positions;

MODEND clm$work_area_manager;
