MODULE mmm$preallocate_file_space;
?? LEFT := 1, RIGHT := 110 ??
?? PUSH (LISTEXT := ON) ??
*copyc mmp$advise_out
*copyc mmp$assign_pages
*copyc mmp$write_modified_pages
*copyc osp$flush_allocation_info
*copyc dmp$allocate_file_space_r1
*copyc gfp$get_segment_sfid
*copyc mmp$validate_segment_number
*copyc syp$push_inhibit_job_recovery
*copyc syp$pop_inhibit_job_recovery
*copyc amt$segment_pointer
*copyc ost$wait
*copyc osd$virtual_address
*copyc ost$caller_identifier
*copyc osv$page_size
*copyc osp$set_status_abnormal
*copyc mme$condition_codes
?? POP ??
*copyc mmh$preallocate_file_space
?? TITLE := 'PROCEDURE mmp$preallocate_file_space', EJECT ??

  PROCEDURE [XDCL, #GATE] mmp$preallocate_file_space
    (    pva: amt$segment_pointer;
         length: ost$segment_length;
         wait_for_allocation: boolean;
     VAR status: ost$status);

    VAR
      sfid: gft$system_file_identifier,
      p_chunk: ^cell,
      p_segment: ^cell,
      remainder: ost$segment_length,
      sdt_p: ^mmt$segment_descriptor,
      sdtx_p: ^mmt$segment_descriptor_extended,
      caller_id: ost$caller_identifier,
      wait: ost$wait,
      chunk_length: ost$segment_length;

    status.normal := TRUE;

    CASE pva.kind OF
    = amc$cell_pointer =
      p_segment := pva.cell_pointer;
    = amc$heap_pointer =
      p_segment := #LOC (pva.heap_pointer^);
    = amc$sequence_pointer =
      p_segment := #LOC (pva.sequence_pointer^);
    ELSE
      osp$set_status_abnormal ('MM', mme$invalid_pva, '', status);
      RETURN
    CASEND;

    mmp$validate_segment_number (#SEGMENT (p_segment), sdt_p, sdtx_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    #CALLER_ID (caller_id);
    IF #RING (p_segment) = 0 THEN
      osp$set_status_abnormal ('MM', mme$invalid_pva, '', status);
      RETURN;
    IFEND;

    IF (caller_id.ring > sdt_p^.ste.r1) OR (sdt_p^.ste.wp = osc$non_writable) THEN
      osp$set_status_abnormal ('MM', mme$invalid_pva, '', status);
      RETURN;
    IFEND;

    syp$push_inhibit_job_recovery;
    gfp$get_segment_sfid (p_segment, sfid, status);
    IF NOT status.normal THEN
      syp$pop_inhibit_job_recovery;
      RETURN;
    IFEND;

    IF wait_for_allocation THEN
      wait := osc$wait;
    ELSE
      wait := osc$nowait;
    IFEND;

    dmp$allocate_file_space_r1 (sfid, #OFFSET (p_segment), length, 0, wait,
        sdtx_p^.file_limits_enforced, status);
    syp$pop_inhibit_job_recovery;
    IF NOT status.normal THEN
      osp$set_status_abnormal ('MM', mme$preallocate_failed, '', status);
      RETURN;
    IFEND;

    IF length > (osv$page_size * 100) THEN
      chunk_length := osv$page_size * 100;
    ELSE
      chunk_length := length;
    IFEND;
    remainder := length;
    p_chunk := p_segment;

    WHILE remainder > 0 DO
      mmp$assign_pages (p_chunk, chunk_length, {preset_pages=} TRUE, osc$wait, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      mmp$advise_out (p_chunk, chunk_length, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      p_chunk := #ADDRESS (#ring (p_chunk), #segment (p_chunk), #offset (p_chunk) + chunk_length);
      remainder := remainder - chunk_length;
      IF remainder < chunk_length THEN
        chunk_length := remainder;
      IFEND
    WHILEND;

    mmp$write_modified_pages (p_segment, length, osc$wait, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    osp$flush_allocation_info (status);
    IF NOT status.normal THEN
      osp$set_status_abnormal ('MM', mme$preallocate_failed, '', status);
      RETURN;
    IFEND;

  PROCEND mmp$preallocate_file_space;
MODEND
