fortrangoingonforty/armfortas / 006f299

Browse files

Sign-extend ALLOCATE/DEALLOCATE STAT= scratch i32 back to wider integer kinds

Authored by espadonne
Committed by mfwolffe
SHA
006f299eb3f635edb69f62759844be2835dfc90e
Parents
4da4c66
Tree
cc72428

2 changed files

StatusFile+-
M src/ir/lower/core.rs 67 20
M src/ir/lower/stmt.rs 6 2
src/ir/lower/core.rsmodified
@@ -32843,17 +32843,41 @@ pub(super) fn lower_stmt_error(span: crate::lexer::Span, message: &str) -> ! {
3284332843
     std::process::exit(1);
3284432844
 }
3284532845
32846
+/// Result of resolving an ALLOCATE/DEALLOCATE STAT= target: the
32847
+/// address the runtime helper writes to (always i32), plus an
32848
+/// optional writeback to the user's variable for kinds wider than
32849
+/// the default integer. `writeback_user_addr` and `writeback_ty` are
32850
+/// Some when the user's variable is e.g. integer(int64): the call
32851
+/// site stores the runtime's i32 result back via sign-extension at
32852
+/// the end of the statement so that subsequent `if (stat /= 0)`
32853
+/// checks read the actual status, not a stale or partially-written
32854
+/// stack slot. F2018 §9.7.1.3 requires the stat-variable to receive
32855
+/// the status code.
32856
+pub(super) struct AllocateStatTarget {
32857
+    pub runtime_addr: ValueId,
32858
+    pub writeback_user_addr: Option<ValueId>,
32859
+    pub writeback_ty: Option<IrType>,
32860
+}
32861
+
3284632862
 pub(super) fn allocate_status_target_addr(b: &mut FuncBuilder, ctx: &LowerCtx, opts: &[IoControl]) -> ValueId {
32863
+    allocate_status_target(b, ctx, opts).runtime_addr
32864
+}
32865
+
32866
+pub(super) fn allocate_status_target(b: &mut FuncBuilder, ctx: &LowerCtx, opts: &[IoControl]) -> AllocateStatTarget {
3284732867
     let Some(stat_expr) = allocate_keyword_expr(opts, "stat") else {
32848
-        return b.alloca(IrType::Int(IntWidth::I32));
32868
+        return AllocateStatTarget {
32869
+            runtime_addr: b.alloca(IrType::Int(IntWidth::I32)),
32870
+            writeback_user_addr: None,
32871
+            writeback_ty: None,
32872
+        };
3284932873
     };
3285032874
     // F2018 §9.7.1.3: stat-variable must be a scalar variable of type
3285132875
     // integer with a decimal exponent range of at least four — i.e.
3285232876
     // any kind ≥ default integer is acceptable, not strictly default.
3285332877
     // The runtime helpers store an i32 status, so when the user's
3285432878
     // variable is a wider kind we allocate a scratch i32, pass that
32855
-    // to the runtime, and the caller writes back to the user's var
32856
-    // after the call (handled in the dealloc/alloc emit sites).
32879
+    // to the runtime, and the caller writes the (sign-extended) i32
32880
+    // back to the user's variable after the statement completes.
3285732881
     match &stat_expr.node {
3285832882
         Expr::Name { name } => {
3285932883
             let Some(info) = ctx.locals.get(&name.to_lowercase()) else {
@@ -32871,20 +32895,15 @@ pub(super) fn allocate_status_target_addr(b: &mut FuncBuilder, ctx: &LowerCtx, o
3287132895
                 );
3287232896
             }
3287332897
             if matches!(info.ty, IrType::Int(IntWidth::I32)) {
32874
-                // Default kind — runtime stores directly.
32875
-                if info.by_ref {
32876
-                    b.load(info.addr)
32877
-                } else {
32878
-                    info.addr
32879
-                }
32898
+                let runtime_addr = if info.by_ref { b.load(info.addr) } else { info.addr };
32899
+                AllocateStatTarget { runtime_addr, writeback_user_addr: None, writeback_ty: None }
3288032900
             } else {
32881
-                // Wider kind — return a scratch i32 the runtime can
32882
-                // store to. The user's variable stays uninitialized
32883
-                // (matches gfortran; stdlib's pattern of `stat /= 0`
32884
-                // checks the scratch's zero/non-zero status which the
32885
-                // user reads via a follow-on assignment from the same
32886
-                // call site, not from this variable directly).
32887
-                b.alloca(IrType::Int(IntWidth::I32))
32901
+                let user_addr = if info.by_ref { b.load(info.addr) } else { info.addr };
32902
+                AllocateStatTarget {
32903
+                    runtime_addr: b.alloca(IrType::Int(IntWidth::I32)),
32904
+                    writeback_user_addr: Some(user_addr),
32905
+                    writeback_ty: Some(info.ty.clone()),
32906
+                }
3288832907
             }
3288932908
         }
3289032909
         Expr::ComponentAccess { .. } => {
@@ -32900,10 +32919,20 @@ pub(super) fn allocate_status_target_addr(b: &mut FuncBuilder, ctx: &LowerCtx, o
3290032919
                 crate::sema::symtab::TypeInfo::Integer { kind }
3290132920
                     if *kind == Some(4) && field.dims.is_empty() =>
3290232921
                 {
32903
-                    field_ptr
32904
-                }
32905
-                crate::sema::symtab::TypeInfo::Integer { .. } if field.dims.is_empty() => {
32906
-                    b.alloca(IrType::Int(IntWidth::I32))
32922
+                    AllocateStatTarget { runtime_addr: field_ptr, writeback_user_addr: None, writeback_ty: None }
32923
+                }
32924
+                crate::sema::symtab::TypeInfo::Integer { kind } if field.dims.is_empty() => {
32925
+                    let width = match kind {
32926
+                        Some(1) => IntWidth::I8,
32927
+                        Some(2) => IntWidth::I16,
32928
+                        Some(8) => IntWidth::I64,
32929
+                        _ => IntWidth::I64,
32930
+                    };
32931
+                    AllocateStatTarget {
32932
+                        runtime_addr: b.alloca(IrType::Int(IntWidth::I32)),
32933
+                        writeback_user_addr: Some(field_ptr),
32934
+                        writeback_ty: Some(IrType::Int(width)),
32935
+                    }
3290732936
                 }
3290832937
                 _ => lower_stmt_error(
3290932938
                     stat_expr.span,
@@ -32918,6 +32947,24 @@ pub(super) fn allocate_status_target_addr(b: &mut FuncBuilder, ctx: &LowerCtx, o
3291832947
     }
3291932948
 }
3292032949
32950
+/// Sign-extend the runtime's i32 stat result back into the user's
32951
+/// wider integer variable, if STAT= named one. No-op when the user
32952
+/// variable is the default integer kind (runtime wrote directly) or
32953
+/// when no STAT= clause is present.
32954
+pub(super) fn emit_allocate_status_writeback(b: &mut FuncBuilder, target: &AllocateStatTarget) {
32955
+    let (Some(user_addr), Some(ty)) = (target.writeback_user_addr, target.writeback_ty.as_ref()) else {
32956
+        return;
32957
+    };
32958
+    let i32_val = b.load_typed(target.runtime_addr, IrType::Int(IntWidth::I32));
32959
+    let widened = match ty {
32960
+        IrType::Int(IntWidth::I32) => i32_val,
32961
+        IrType::Int(width @ (IntWidth::I8 | IntWidth::I16)) => b.int_trunc(i32_val, *width),
32962
+        IrType::Int(width) => b.int_extend(i32_val, *width, true),
32963
+        _ => return,
32964
+    };
32965
+    b.store(widened, user_addr);
32966
+}
32967
+
3292132968
 pub(super) fn resolve_errmsg_target_expr(
3292232969
     b: &mut FuncBuilder,
3292332970
     ctx: &LowerCtx,
src/ir/lower/stmt.rsmodified
@@ -3031,7 +3031,8 @@ pub(crate) fn lower_stmt(b: &mut FuncBuilder, ctx: &mut LowerCtx, stmt: &Spanned
30313031
             items,
30323032
             opts,
30333033
         } => {
3034
-            let stat_addr = allocate_status_target_addr(b, ctx, opts);
3034
+            let stat_target = super::core::allocate_status_target(b, ctx, opts);
3035
+            let stat_addr = stat_target.runtime_addr;
30353036
             // F2018 §9.7.1.3: stat-variable is 0 on success. Pre-zero so
30363037
             // any item path that doesn't update stat_addr (e.g. scalar
30373038
             // simple allocates that don't go through a runtime helper)
@@ -3802,10 +3803,12 @@ pub(crate) fn lower_stmt(b: &mut FuncBuilder, ctx: &mut LowerCtx, stmt: &Spanned
38023803
                     }
38033804
                 }
38043805
             }
3806
+            super::core::emit_allocate_status_writeback(b, &stat_target);
38053807
         }
38063808
38073809
         Stmt::Deallocate { items, opts } => {
3808
-            let stat_addr = allocate_status_target_addr(b, ctx, opts);
3810
+            let dealloc_stat_target = super::core::allocate_status_target(b, ctx, opts);
3811
+            let stat_addr = dealloc_stat_target.runtime_addr;
38093812
             let errmsg_target = allocate_errmsg_target(b, ctx, opts);
38103813
             for item in items {
38113814
                 if let Expr::ComponentAccess { .. } = &item.node {
@@ -3911,6 +3914,7 @@ pub(crate) fn lower_stmt(b: &mut FuncBuilder, ctx: &mut LowerCtx, stmt: &Spanned
39113914
                     }
39123915
                 }
39133916
             }
3917
+            super::core::emit_allocate_status_writeback(b, &dealloc_stat_target);
39143918
         }
39153919
39163920
         Stmt::Block {