Rust · 57524 bytes Raw Blame History
1 //! Allocation of local variables from declarations.
2 //!
3 //! Extracted from `core.rs` in Sprint 11 Stage E. Pure mechanical
4 //! move — behavior unchanged.
5
6 use std::collections::HashMap;
7
8 use crate::ast::decl::{ArraySpec, Decl, TypeSpec};
9 use crate::ir::builder::FuncBuilder;
10 use crate::ir::inst::*;
11 use crate::ir::types::*;
12 use crate::sema::symtab::SymbolTable;
13
14 use super::const_scalar::{clamp_const_to_type, ConstScalar};
15 use super::core::*;
16 use super::ctx::{CharKind, LocalInfo};
17 use super::helpers::{clamp_nonnegative_i64, widen_to_i64};
18
19 /// Allocate local variables from declarations. Handles both scalars and arrays.
20 pub(crate) fn alloc_decls(
21 b: &mut FuncBuilder,
22 locals: &mut HashMap<String, LocalInfo>,
23 decls: &[crate::ast::decl::SpannedDecl],
24 visible_param_consts: &HashMap<String, ConstScalar>,
25 type_layouts: &crate::sema::type_layout::TypeLayoutRegistry,
26 pending_globals: &mut Vec<PendingGlobal>,
27 func_name: &str,
28 st: &SymbolTable,
29 ) {
30 use crate::ast::decl::Attribute;
31
32 // Pre-scan standalone PARAMETER statements so a TypeDecl entity
33 // whose value comes from a separate `parameter (name = expr)`
34 // statement still triggers SAVE-promotion at alloc time. Without
35 // this pre-scan, the standalone form would silently fall back to
36 // the alloca + per-call store path.
37 let mut parameter_inits: HashMap<String, &crate::ast::expr::SpannedExpr> = HashMap::new();
38 for d in decls {
39 if let Decl::ParameterStmt { pairs } = &d.node {
40 for (name, expr) in pairs {
41 parameter_inits.insert(name.to_lowercase(), expr);
42 }
43 }
44 }
45
46 // Audit CRITICAL-1: build the per-scope parameter constants
47 // table so SAVE-promotion's eval_const_global_init can resolve
48 // `Expr::Name` references against compile-time-known parameters
49 // declared earlier in the same scope. Without this, an init
50 // like `integer :: x = k * 2` (k a parameter) silently falls
51 // back to alloca + per-call store and breaks SAVE semantics.
52 //
53 // Parameters can reference earlier parameters (`tau = 2 * pi`),
54 // so we walk decls in order and build the map incrementally.
55 let param_consts = collect_decl_param_consts_with_scope(decls, visible_param_consts, st);
56 let param_char_consts = collect_decl_param_char_consts(decls, &param_consts, type_layouts);
57
58 for decl in decls {
59 if let Decl::TypeDecl {
60 type_spec,
61 attrs,
62 entities,
63 } = &decl.node
64 {
65 let elem_ty =
66 lower_type_spec_with_param_consts(type_spec, Some(&param_consts), Some(st));
67
68 let attr_dims: Option<&Vec<ArraySpec>> = attrs.iter().find_map(|a| {
69 if let Attribute::Dimension(specs) = a {
70 Some(specs)
71 } else {
72 None
73 }
74 });
75 let is_allocatable = attrs.iter().any(|a| matches!(a, Attribute::Allocatable));
76 let is_pointer_attr = attrs.iter().any(|a| matches!(a, Attribute::Pointer));
77
78 for entity in entities {
79 let key = entity.name.to_lowercase();
80 if locals.contains_key(&key) {
81 continue;
82 }
83 let init_expr: Option<&crate::ast::expr::SpannedExpr> = entity
84 .init
85 .as_ref()
86 .or_else(|| parameter_inits.get(&key).copied());
87
88 // Use entity-level array spec, or fall back to attribute-level DIMENSION.
89 let array_spec = entity.array_spec.as_ref().or(attr_dims);
90
91 // Check for character type.
92 let char_len =
93 declared_char_len(type_spec, init_expr, &param_consts, &param_char_consts, st);
94 let runtime_char_len_expr = match type_spec {
95 TypeSpec::Character(Some(sel)) => match &sel.len {
96 Some(crate::ast::decl::LenSpec::Expr(e))
97 if eval_const_int_in_scope_or_any_scope(e, &param_consts, st)
98 .is_none() =>
99 {
100 Some(e)
101 }
102 _ => None,
103 },
104 _ => None,
105 };
106 let is_deferred_char = matches!(type_spec,
107 TypeSpec::Character(Some(sel)) if matches!(&sel.len, Some(crate::ast::decl::LenSpec::Colon))
108 );
109
110 if is_pointer_attr && array_spec.is_some() {
111 // Pointer to array. Reuses the 384-byte array
112 // descriptor layout that allocatables use: the
113 // pointer slot carries base_addr, elem_size,
114 // rank, flags, and per-dim bounds so that
115 // downstream subscript / SIZE / whole-array
116 // operations pick it up through the existing
117 // descriptor path. `=>` fills the slot from a
118 // materialised descriptor of the target (see
119 // Stmt::PointerAssignment). Unassociated state
120 // is encoded by flags=0, same as an unallocated
121 // allocatable.
122 //
123 // We set `allocatable = true` so that
124 // `local_uses_array_descriptor` and
125 // `array_descriptor_addr` treat the slot as a
126 // descriptor-at-info.addr (no extra indirection).
127 // `is_pointer = true` is separately used by
128 // scope-exit deallocation to suppress the
129 // afs_deallocate_array call — a pointer does
130 // not own its target.
131 let desc_ty = IrType::Array(Box::new(IrType::Int(IntWidth::I8)), 384);
132 let addr = b.alloca(desc_ty);
133 let zero_byte = b.const_i32(0);
134 let size384 = b.const_i64(384);
135 b.call(
136 FuncRef::External("memset".into()),
137 vec![addr, zero_byte, size384],
138 IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))),
139 );
140 // dims is left empty for a deferred-shape pointer;
141 // the descriptor carries the runtime rank and
142 // bounds after `=>` binds it to a target.
143 let pointer_elem_ty = if matches!(type_spec, TypeSpec::Character(_)) {
144 match char_len {
145 Some(len) => fixed_char_storage_ir_type(len),
146 None => elem_ty.clone(),
147 }
148 } else if let TypeSpec::Type(ref type_name) = type_spec {
149 derived_storage_ir_type(type_name, type_layouts)
150 .unwrap_or_else(|| elem_ty.clone())
151 } else {
152 elem_ty.clone()
153 };
154 let pointer_char_kind = if matches!(type_spec, TypeSpec::Character(_)) {
155 match char_len {
156 Some(len) => CharKind::Fixed(len),
157 None => CharKind::None,
158 }
159 } else {
160 CharKind::None
161 };
162 locals.insert(
163 key,
164 LocalInfo {
165 addr,
166 ty: pointer_elem_ty,
167 dims: vec![],
168 allocatable: true,
169 descriptor_arg: false,
170 by_ref: false,
171 char_kind: pointer_char_kind,
172 derived_type: match type_spec {
173 TypeSpec::Type(type_name) => Some(type_name.clone()),
174 _ => None,
175 },
176 inline_const: None,
177 is_pointer: true,
178 runtime_dim_upper: array_spec
179 .as_ref()
180 .map(|specs| vec![None; specs.len()])
181 .unwrap_or_default(),
182 is_class: false,
183 logical_kind: None,
184 last_dim_assumed_size: false,
185 },
186 );
187 continue;
188 }
189 if is_pointer_attr && matches!(type_spec, TypeSpec::Type(_)) && array_spec.is_none()
190 {
191 // Pointer to derived type. Slot holds an 8-byte
192 // pointer to the target struct; ComponentAccess
193 // loads the slot and uses that address as the
194 // struct base. derived_type is stored so that
195 // component lookup can find the type layout.
196 if let TypeSpec::Type(ref type_name) = type_spec {
197 let addr = b.alloca(IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))));
198 let zero_byte = b.const_i32(0);
199 let eight = b.const_i64(8);
200 b.call(
201 FuncRef::External("memset".into()),
202 vec![addr, zero_byte, eight],
203 IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))),
204 );
205 locals.insert(
206 key,
207 LocalInfo {
208 addr,
209 ty: IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))),
210 dims: vec![],
211 allocatable: false,
212 descriptor_arg: false,
213 by_ref: false,
214 char_kind: CharKind::None,
215 derived_type: Some(type_name.clone()),
216 inline_const: None,
217 is_pointer: true,
218 runtime_dim_upper: vec![],
219 is_class: false,
220 logical_kind: None,
221 last_dim_assumed_size: false,
222 },
223 );
224 continue;
225 }
226 }
227 if is_pointer_attr && matches!(type_spec, TypeSpec::Class(_)) && array_spec.is_none()
228 {
229 if let TypeSpec::Class(ref type_name) = type_spec {
230 let desc_ty = IrType::Array(Box::new(IrType::Int(IntWidth::I8)), 384);
231 let addr = b.alloca(desc_ty);
232 let zero = b.const_i32(0);
233 let size384 = b.const_i64(384);
234 b.call(
235 FuncRef::External("memset".into()),
236 vec![addr, zero, size384],
237 IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))),
238 );
239 locals.insert(
240 key,
241 LocalInfo {
242 addr,
243 ty: IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))),
244 dims: vec![],
245 allocatable: false,
246 descriptor_arg: true,
247 by_ref: false,
248 char_kind: CharKind::None,
249 derived_type: Some(type_name.clone()),
250 inline_const: None,
251 is_pointer: true,
252 runtime_dim_upper: vec![],
253 is_class: true,
254 logical_kind: None,
255 last_dim_assumed_size: false,
256 },
257 );
258 continue;
259 }
260 }
261 if is_deferred_char && (is_allocatable || is_pointer_attr) && array_spec.is_none() {
262 // Deferred-length allocatable/pointer scalar character:
263 // 32-byte StringDescriptor. Deferred-length arrays fall
264 // through to the general descriptor path below.
265 let desc_ty = IrType::Array(Box::new(IrType::Int(IntWidth::I8)), 32);
266 let addr = b.alloca(desc_ty);
267 let zero = b.const_i32(0);
268 let size32 = b.const_i64(32);
269 b.call(
270 FuncRef::External("memset".into()),
271 vec![addr, zero, size32],
272 IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))),
273 );
274 locals.insert(
275 key,
276 LocalInfo {
277 addr,
278 ty: IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))),
279 dims: vec![],
280 allocatable: true,
281 descriptor_arg: false,
282 by_ref: false,
283 char_kind: CharKind::Deferred,
284 derived_type: None,
285 inline_const: None,
286 is_pointer: is_pointer_attr,
287 runtime_dim_upper: vec![],
288 is_class: false,
289 logical_kind: None,
290 last_dim_assumed_size: false,
291 },
292 );
293 continue;
294 }
295
296 if let Some(specs) = array_spec.filter(|_| !is_allocatable) {
297 if (!matches!(type_spec, TypeSpec::Character(_)) || char_len.is_some())
298 && array_spec_has_runtime_bounds(specs, &param_consts, Some(st))
299 {
300 let dims = extract_array_dims_with_init(
301 specs,
302 init_expr,
303 &param_consts,
304 Some(st),
305 );
306 let (array_elem_ty, array_derived_type, array_char_kind) = if matches!(
307 type_spec,
308 TypeSpec::Character(_)
309 ) {
310 let len = char_len.expect(
311 "runtime-bound explicit-shape character array should have a fixed element length",
312 );
313 (fixed_char_storage_ir_type(len), None, CharKind::Fixed(len))
314 } else if let TypeSpec::Type(ref type_name) = type_spec {
315 if let Some(layout) = type_layouts.get(type_name) {
316 (
317 IrType::Array(
318 Box::new(IrType::Int(IntWidth::I8)),
319 layout.size as u64,
320 ),
321 Some(type_name.clone()),
322 CharKind::None,
323 )
324 } else {
325 (elem_ty.clone(), None, CharKind::None)
326 }
327 } else {
328 (elem_ty.clone(), None, CharKind::None)
329 };
330
331 let desc_ty = IrType::Array(Box::new(IrType::Int(IntWidth::I8)), 384);
332 let addr = b.alloca(desc_ty);
333 let zero = b.const_i32(0);
334 let size384 = b.const_i64(384);
335 b.call(
336 FuncRef::External("memset".into()),
337 vec![addr, zero, size384],
338 IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))),
339 );
340
341 let rank = specs.len();
342 let one_i64 = b.const_i64(1);
343 let dim_buf = if rank == 0 {
344 b.const_i64(0)
345 } else {
346 let dim_buf_bytes = (rank * 24) as u64;
347 let dim_buf = b.alloca(IrType::Array(
348 Box::new(IrType::Int(IntWidth::I8)),
349 dim_buf_bytes,
350 ));
351 // Column-major stride accumulator: dim[k].stride =
352 // product(extents[0..k]). Without this, every dim
353 // got stride=1 — `center(i, :) = ...` walked the
354 // row axis in element-stride-1 (touching only the
355 // first column entry per row) instead of the
356 // column axis in stride=m, so multi-dim section
357 // assigns to a runtime-shape local silently
358 // wrote bogus values.
359 let mut running_stride = one_i64;
360 for (i, spec) in specs.iter().enumerate() {
361 let (lo64, up64) = match spec {
362 ArraySpec::Explicit { lower, upper } => {
363 let lo64 = lower
364 .as_ref()
365 .and_then(|expr| {
366 eval_const_array_bound(
367 expr,
368 &param_consts,
369 Some(st),
370 )
371 })
372 .map(|value| b.const_i64(value))
373 .unwrap_or_else(|| {
374 if let Some(expr) = lower.as_ref() {
375 let raw = super::expr::lower_expr_with_optional_layouts(
376 b,
377 locals,
378 expr,
379 st,
380 Some(type_layouts),
381 );
382 widen_to_i64(b, raw)
383 } else {
384 b.const_i64(1)
385 }
386 });
387 let up64 =
388 eval_const_array_bound(upper, &param_consts, Some(st))
389 .map(|value| b.const_i64(value))
390 .unwrap_or_else(|| {
391 let raw = super::expr::lower_expr_with_optional_layouts(
392 b,
393 locals,
394 upper,
395 st,
396 Some(type_layouts),
397 );
398 widen_to_i64(b, raw)
399 });
400 (lo64, up64)
401 }
402 _ => (b.const_i64(1), b.const_i64(1)),
403 };
404 let base = (i * 24) as i64;
405 let off_lo = b.const_i64(base);
406 let off_up = b.const_i64(base + 8);
407 let off_st = b.const_i64(base + 16);
408 let p_lo = b.gep(dim_buf, vec![off_lo], IrType::Int(IntWidth::I8));
409 let p_up = b.gep(dim_buf, vec![off_up], IrType::Int(IntWidth::I8));
410 let p_st = b.gep(dim_buf, vec![off_st], IrType::Int(IntWidth::I8));
411 b.store(lo64, p_lo);
412 b.store(up64, p_up);
413 b.store(running_stride, p_st);
414 if i + 1 < rank {
415 let span = b.isub(up64, lo64);
416 let extent = b.iadd(span, one_i64);
417 running_stride = b.imul(running_stride, extent);
418 }
419 }
420 dim_buf
421 };
422
423 let elem_size = b.const_i64(ir_scalar_byte_size(&array_elem_ty));
424 let rank_val = b.const_i32(rank as i32);
425 let stat_slot = b.alloca(IrType::Int(IntWidth::I32));
426 b.call(
427 FuncRef::External("afs_allocate_array".into()),
428 vec![addr, elem_size, rank_val, dim_buf, stat_slot],
429 IrType::Void,
430 );
431
432 if let Some(len) = char_len {
433 let total = b.call(
434 FuncRef::External("afs_array_size".into()),
435 vec![addr],
436 IrType::Int(IntWidth::I64),
437 );
438 let byte_count = if len == 1 {
439 total
440 } else {
441 let elem_len = b.const_i64(len);
442 b.imul(total, elem_len)
443 };
444 let byte_base = if matches!(array_elem_ty, IrType::Int(IntWidth::I8)) {
445 b.load_typed(addr, IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))))
446 } else {
447 let base = b
448 .load_typed(addr, IrType::Ptr(Box::new(array_elem_ty.clone())));
449 let zero = b.const_i64(0);
450 b.gep(base, vec![zero], IrType::Int(IntWidth::I8))
451 };
452 let space = b.const_i32(b' ' as i32);
453 b.call(
454 FuncRef::External("memset".into()),
455 vec![byte_base, space, byte_count],
456 IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))),
457 );
458 }
459
460 locals.insert(
461 key,
462 LocalInfo {
463 addr,
464 ty: array_elem_ty,
465 dims,
466 allocatable: true,
467 descriptor_arg: false,
468 by_ref: false,
469 char_kind: array_char_kind,
470 derived_type: array_derived_type,
471 inline_const: None,
472 is_pointer: false,
473 runtime_dim_upper: vec![],
474 is_class: false,
475 logical_kind: None,
476 last_dim_assumed_size: false,
477 },
478 );
479 continue;
480 }
481 }
482
483 if let Some(len) = char_len {
484 if let Some(specs) = array_spec.filter(|_| !is_allocatable) {
485 // Fixed-length character arrays use contiguous inline
486 // element storage, not a pointer-slot table. The slot
487 // table was a legacy lowering artifact that let reads
488 // load the element bytes as if they were an address,
489 // which is exactly how local `character(len=N),
490 // parameter :: builtins(...)` ended up crashing fortsh
491 // `type`/`command` with `0x202020...` memmove faults.
492 let dims = extract_array_dims_with_init(
493 specs,
494 init_expr,
495 &param_consts,
496 Some(st),
497 );
498 let total_size: i64 = dims.iter().map(|(_, size)| *size).product();
499 let elem_ty = fixed_char_storage_ir_type(len);
500 let elem_bytes = ir_scalar_byte_size(&elem_ty);
501 let total_bytes = total_size * elem_bytes;
502 let space = b.const_i32(b' ' as i32);
503 let total_bytes_val = b.const_i64(total_bytes);
504 const STACK_THRESHOLD: i64 = 64 * 1024;
505
506 if total_bytes >= STACK_THRESHOLD {
507 let desc_ty = IrType::Array(Box::new(IrType::Int(IntWidth::I8)), 384);
508 let addr = b.alloca(desc_ty);
509 let zero = b.const_i32(0);
510 let size384 = b.const_i64(384);
511 b.call(
512 FuncRef::External("memset".into()),
513 vec![addr, zero, size384],
514 IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))),
515 );
516 let es = b.const_i64(elem_bytes);
517 let n = b.const_i64(total_size);
518 b.call(
519 FuncRef::External("afs_allocate_1d".into()),
520 vec![addr, es, n],
521 IrType::Void,
522 );
523 let base = b
524 .load_typed(addr, IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))));
525 b.call(
526 FuncRef::External("memset".into()),
527 vec![base, space, total_bytes_val],
528 IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))),
529 );
530 locals.insert(
531 key,
532 LocalInfo {
533 addr,
534 ty: elem_ty,
535 dims,
536 allocatable: true,
537 descriptor_arg: false,
538 by_ref: false,
539 char_kind: CharKind::Fixed(len),
540 derived_type: None,
541 inline_const: None,
542 is_pointer: false,
543 runtime_dim_upper: vec![],
544 is_class: false,
545 logical_kind: None,
546 last_dim_assumed_size: false,
547 },
548 );
549 } else {
550 let arr_ty =
551 IrType::Array(Box::new(elem_ty.clone()), total_size as u64);
552 let addr = b.alloca(arr_ty);
553 b.call(
554 FuncRef::External("memset".into()),
555 vec![addr, space, total_bytes_val],
556 IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))),
557 );
558 locals.insert(
559 key,
560 LocalInfo {
561 addr,
562 ty: elem_ty,
563 dims,
564 allocatable: false,
565 descriptor_arg: false,
566 by_ref: false,
567 char_kind: CharKind::Fixed(len),
568 derived_type: None,
569 inline_const: None,
570 is_pointer: false,
571 runtime_dim_upper: vec![],
572 is_class: false,
573 logical_kind: None,
574 last_dim_assumed_size: false,
575 },
576 );
577 }
578 continue;
579 }
580 if is_pointer_attr && array_spec.is_none() {
581 // Fixed-length scalar character POINTERs use a pointer
582 // slot, not inline character storage. Intrinsics like
583 // c_f_pointer populate this slot with the associated
584 // byte buffer address, and later substring/character
585 // reads must dereference it.
586 let addr = b.alloca(IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))));
587 let zero = b.const_i32(0);
588 let eight = b.const_i64(8);
589 b.call(
590 FuncRef::External("memset".into()),
591 vec![addr, zero, eight],
592 IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))),
593 );
594 locals.insert(
595 key,
596 LocalInfo {
597 addr,
598 ty: IrType::Int(IntWidth::I8),
599 dims: vec![],
600 allocatable: false,
601 descriptor_arg: false,
602 by_ref: false,
603 char_kind: CharKind::Fixed(len),
604 derived_type: None,
605 inline_const: None,
606 is_pointer: true,
607 runtime_dim_upper: vec![],
608 is_class: false,
609 logical_kind: None,
610 last_dim_assumed_size: false,
611 },
612 );
613 continue;
614 }
615 if !is_allocatable {
616 // Fixed-length character(N): alloca N+1 bytes so call-boundary
617 // lowering can rely on a stable trailing NUL while the Fortran
618 // value still occupies the first N bytes.
619 let buf_ty =
620 IrType::Array(Box::new(IrType::Int(IntWidth::I8)), (len + 1) as u64);
621 let addr = b.alloca(buf_ty);
622 let zero = b.const_i32(0);
623 let total = b.const_i64(len + 1);
624 b.call(
625 FuncRef::External("memset".into()),
626 vec![addr, zero, total],
627 IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))),
628 );
629 // Initialize with spaces.
630 let space = b.const_i32(b' ' as i32);
631 let len_val = b.const_i64(len);
632 b.call(
633 FuncRef::External("memset".into()),
634 vec![addr, space, len_val],
635 IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))),
636 );
637 locals.insert(
638 key,
639 LocalInfo {
640 addr,
641 ty: IrType::Int(IntWidth::I8),
642 dims: vec![],
643 allocatable: false,
644 descriptor_arg: false,
645 by_ref: false,
646 char_kind: CharKind::Fixed(len),
647 derived_type: None,
648 inline_const: None,
649 is_pointer: false,
650 runtime_dim_upper: vec![],
651 is_class: false,
652 logical_kind: None,
653 last_dim_assumed_size: false,
654 },
655 );
656 continue; // skip normal path
657 }
658 } else if let Some(len_expr) = runtime_char_len_expr {
659 if !is_allocatable && array_spec.is_none() {
660 // Automatic fixed-length character whose size depends on a
661 // runtime expression such as LEN(input). Materialize a
662 // heap buffer now and remember the runtime length for
663 // substring and assignment lowering.
664 let raw_len = super::expr::lower_expr_with_optional_layouts(
665 b,
666 locals,
667 len_expr,
668 st,
669 Some(type_layouts),
670 );
671 let len_val = clamp_nonnegative_i64(b, raw_len);
672 let len_addr = b.alloca(IrType::Int(IntWidth::I64));
673 b.store(len_val, len_addr);
674
675 let one = b.const_i64(1);
676 let total = b.iadd(len_val, one);
677 let ptr = b.runtime_call(
678 RuntimeFunc::Allocate,
679 vec![total],
680 IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))),
681 );
682 let ptr_slot = b.alloca(IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))));
683 b.store(ptr, ptr_slot);
684
685 let zero = b.const_i32(0);
686 b.call(
687 FuncRef::External("memset".into()),
688 vec![ptr, zero, total],
689 IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))),
690 );
691 let space = b.const_i32(b' ' as i32);
692 b.call(
693 FuncRef::External("memset".into()),
694 vec![ptr, space, len_val],
695 IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))),
696 );
697
698 locals.insert(
699 key,
700 LocalInfo {
701 addr: ptr_slot,
702 ty: IrType::Int(IntWidth::I8),
703 dims: vec![],
704 allocatable: false,
705 descriptor_arg: false,
706 by_ref: false,
707 char_kind: CharKind::FixedRuntime { len_addr },
708 derived_type: None,
709 inline_const: None,
710 is_pointer: false,
711 runtime_dim_upper: vec![],
712 is_class: false,
713 logical_kind: None,
714 last_dim_assumed_size: false,
715 },
716 );
717 continue;
718 }
719 }
720
721 if is_allocatable {
722 // Allocatable variable: alloca a descriptor (384 bytes), zero-initialized.
723 let desc_ty = IrType::Array(Box::new(IrType::Int(IntWidth::I8)), 384);
724 let addr = b.alloca(desc_ty);
725 // Zero-initialize the descriptor so flags=0 (not allocated).
726 let zero = b.const_i32(0);
727 let size = b.const_i64(384);
728 b.call(
729 FuncRef::External("memset".into()),
730 vec![addr, zero, size],
731 IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))),
732 );
733 let alloc_elem_ty = if matches!(type_spec, TypeSpec::Character(_)) {
734 match char_len {
735 Some(len) => fixed_char_storage_ir_type(len),
736 None => elem_ty.clone(),
737 }
738 } else if let TypeSpec::Type(ref type_name) = type_spec {
739 derived_storage_ir_type(type_name, type_layouts)
740 .unwrap_or_else(|| elem_ty.clone())
741 } else {
742 elem_ty.clone()
743 };
744 let char_kind = match char_len {
745 Some(len) if array_spec.is_some() => CharKind::Fixed(len),
746 _ => CharKind::None,
747 };
748 locals.insert(
749 key,
750 LocalInfo {
751 addr,
752 ty: alloc_elem_ty,
753 dims: vec![],
754 allocatable: true,
755 descriptor_arg: false,
756 by_ref: false,
757 char_kind,
758 derived_type: match type_spec {
759 TypeSpec::Type(type_name) | TypeSpec::Class(type_name) => {
760 Some(type_name.clone())
761 }
762 _ => None,
763 },
764 inline_const: None,
765 is_pointer: false,
766 runtime_dim_upper: array_spec
767 .as_ref()
768 .map(|specs| vec![None; specs.len()])
769 .unwrap_or_default(),
770 is_class: matches!(type_spec, TypeSpec::Class(_)),
771 logical_kind: if let TypeSpec::Logical(sel) = type_spec {
772 Some(extract_kind_with_context(sel, 4, Some(&param_consts), Some(st)))
773 } else {
774 None
775 },
776 last_dim_assumed_size: false,
777 },
778 );
779 } else if let Some(specs) = array_spec {
780 // Fixed-size array variable.
781 let dims = extract_array_dims_with_init(
782 specs,
783 init_expr,
784 &param_consts,
785 Some(st),
786 );
787 let total_size: i64 = dims.iter().map(|(_, size)| *size).product();
788 let (array_elem_ty, array_derived_type, array_char_kind) =
789 if matches!(type_spec, TypeSpec::Character(_)) {
790 if let Some(len) = char_len {
791 (fixed_char_storage_ir_type(len), None, CharKind::Fixed(len))
792 } else {
793 (elem_ty.clone(), None, CharKind::None)
794 }
795 } else if let TypeSpec::Type(ref type_name) = type_spec {
796 if let Some(layout) = type_layouts.get(type_name) {
797 (
798 IrType::Array(
799 Box::new(IrType::Int(IntWidth::I8)),
800 layout.size as u64,
801 ),
802 Some(type_name.clone()),
803 CharKind::None,
804 )
805 } else {
806 (elem_ty.clone(), None, CharKind::None)
807 }
808 } else {
809 (elem_ty.clone(), None, CharKind::None)
810 };
811 let elem_bytes = ir_scalar_byte_size(&array_elem_ty);
812 let total_bytes = total_size * elem_bytes;
813 const STACK_THRESHOLD: i64 = 64 * 1024; // 64KB
814
815 if total_bytes >= STACK_THRESHOLD {
816 // Large array: use descriptor + heap allocation (prevents stack overflow).
817 let desc_ty = IrType::Array(Box::new(IrType::Int(IntWidth::I8)), 384);
818 let addr = b.alloca(desc_ty);
819 let zero = b.const_i32(0);
820 let size384 = b.const_i64(384);
821 b.call(
822 FuncRef::External("memset".into()),
823 vec![addr, zero, size384],
824 IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))),
825 );
826 // Auto-allocate with the declared shape.
827 let es = b.const_i64(elem_bytes);
828 let n = b.const_i64(total_size);
829 b.call(
830 FuncRef::External("afs_allocate_1d".into()),
831 vec![addr, es, n],
832 IrType::Void,
833 );
834 if let Some(ref type_name) = array_derived_type {
835 if let Some(layout) = type_layouts.get(type_name) {
836 if derived_layout_needs_runtime_initialization(layout, type_layouts)
837 {
838 let base_ptr = b.load_typed(
839 addr,
840 IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))),
841 );
842 initialize_derived_array_storage(
843 b,
844 base_ptr,
845 layout,
846 total_size.max(0),
847 type_layouts,
848 );
849 }
850 }
851 }
852 // Mark as allocatable so scope-exit dealloc fires.
853 locals.insert(
854 key,
855 LocalInfo {
856 addr,
857 ty: array_elem_ty.clone(),
858 dims,
859 allocatable: true,
860 descriptor_arg: false,
861 by_ref: false,
862 char_kind: array_char_kind.clone(),
863 derived_type: array_derived_type.clone(),
864 inline_const: None,
865 is_pointer: false,
866 runtime_dim_upper: vec![],
867 is_class: false,
868 logical_kind: if let TypeSpec::Logical(sel) = type_spec {
869 Some(extract_kind_with_context(sel, 4, Some(&param_consts), Some(st)))
870 } else {
871 None
872 },
873 last_dim_assumed_size: false,
874 },
875 );
876 } else {
877 // Small array: stack allocation.
878 let arr_ty =
879 IrType::Array(Box::new(array_elem_ty.clone()), total_size as u64);
880 let addr = b.alloca(arr_ty);
881 if let Some(ref type_name) = array_derived_type {
882 if let Some(layout) = type_layouts.get(type_name) {
883 if derived_layout_needs_runtime_initialization(layout, type_layouts)
884 {
885 initialize_derived_array_storage(
886 b,
887 addr,
888 layout,
889 total_size.max(0),
890 type_layouts,
891 );
892 }
893 }
894 }
895 locals.insert(
896 key,
897 LocalInfo {
898 addr,
899 ty: array_elem_ty.clone(),
900 dims,
901 allocatable: false,
902 descriptor_arg: false,
903 by_ref: false,
904 char_kind: array_char_kind,
905 derived_type: array_derived_type,
906 inline_const: None,
907 is_pointer: false,
908 runtime_dim_upper: vec![],
909 is_class: false,
910 logical_kind: type_spec_logical_kind(type_spec, Some(&param_consts), Some(st)),
911 last_dim_assumed_size: false,
912 },
913 );
914 }
915 } else if let TypeSpec::Type(ref type_name) = type_spec {
916 // Derived type variable: allocate struct-sized byte array.
917 if let Some(layout) = type_layouts.get(type_name) {
918 let struct_ty =
919 IrType::Array(Box::new(IrType::Int(IntWidth::I8)), layout.size as u64);
920 let addr = b.alloca(struct_ty);
921 if derived_layout_needs_runtime_initialization(layout, type_layouts) {
922 initialize_derived_storage(b, addr, layout, type_layouts);
923 }
924 // Store the derived type name in the ty field for component access lookup.
925 // Use Ptr<i8> as a marker — the type_layouts registry is used for field resolution.
926 locals.insert(
927 key,
928 LocalInfo {
929 addr,
930 ty: IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))),
931 dims: vec![],
932 allocatable: false,
933 descriptor_arg: false,
934 by_ref: false,
935 char_kind: CharKind::None,
936 derived_type: Some(type_name.clone()),
937 inline_const: None,
938 is_pointer: false,
939 runtime_dim_upper: vec![],
940 is_class: false,
941 logical_kind: None,
942 last_dim_assumed_size: false,
943 },
944 );
945 } else {
946 // Unknown derived type — fall back to 8-byte alloca.
947 let addr = b.alloca(IrType::Int(IntWidth::I64));
948 locals.insert(
949 key,
950 LocalInfo {
951 addr,
952 ty: elem_ty.clone(),
953 dims: vec![],
954 allocatable: false,
955 descriptor_arg: false,
956 by_ref: false,
957 char_kind: CharKind::None,
958 derived_type: None,
959 inline_const: None,
960 is_pointer: false,
961 runtime_dim_upper: vec![],
962 is_class: false,
963 logical_kind: None,
964 last_dim_assumed_size: false,
965 },
966 );
967 }
968 } else if is_pointer_attr && array_spec.is_none() {
969 // Scalar Fortran POINTER: allocate a pointer slot
970 // (`alloca ptr<elem_ty>`) that holds the address
971 // of whatever the pointer is currently associated
972 // with. `=>` stores into this slot; plain `=`
973 // dereferences it; reads load twice. The slot
974 // starts null so that ASSOCIATED() returns
975 // false before the first `=>`.
976 let addr = b.alloca(IrType::Ptr(Box::new(elem_ty.clone())));
977 // Memset the slot to zero so unassociated pointers
978 // compare null. Eight bytes matches the ARM64
979 // pointer width.
980 let zero_byte = b.const_i32(0);
981 let eight = b.const_i64(8);
982 b.call(
983 FuncRef::External("memset".into()),
984 vec![addr, zero_byte, eight],
985 IrType::Ptr(Box::new(IrType::Int(IntWidth::I8))),
986 );
987 locals.insert(
988 key,
989 LocalInfo {
990 addr,
991 ty: elem_ty.clone(),
992 dims: vec![],
993 allocatable: false,
994 descriptor_arg: false,
995 by_ref: false,
996 char_kind: CharKind::None,
997 derived_type: None,
998 inline_const: None,
999 is_pointer: true,
1000 runtime_dim_upper: vec![],
1001 is_class: false,
1002 logical_kind: None,
1003 last_dim_assumed_size: false,
1004 },
1005 );
1006 } else {
1007 // Scalar variable. Three sub-cases:
1008 // (a) PARAMETER-attributed and folds → inline
1009 // at every use site. No alloca, no global,
1010 // no .data slot. Audit MAJOR-4.
1011 // (b) Has a const-evaluable init but isn't a
1012 // parameter → SAVE-promote to a module
1013 // global (F2018 §8.5.16 implicit SAVE).
1014 // (c) Plain alloca, no init.
1015 let is_parameter = attrs.iter().any(|a| matches!(a, Attribute::Parameter))
1016 || parameter_inits.contains_key(&key);
1017
1018 if is_parameter {
1019 let folded = init_expr
1020 .and_then(|e| {
1021 eval_const_scalar_with_decl_scope(e, decls, &param_consts, st)
1022 .or_else(|| param_consts.get(&key).copied())
1023 .or_else(|| symbol_table_parameter_const(st, &key))
1024 })
1025 .map(|raw| clamp_const_to_type(raw, &elem_ty));
1026 if let Some(value) = folded {
1027 // Sentinel alloca — never read.
1028 let addr = b.alloca(elem_ty.clone());
1029 locals.insert(
1030 key,
1031 LocalInfo {
1032 addr,
1033 ty: elem_ty.clone(),
1034 dims: vec![],
1035 allocatable: false,
1036 descriptor_arg: false,
1037 by_ref: false,
1038 char_kind: CharKind::None,
1039 derived_type: None,
1040 inline_const: Some(value),
1041 is_pointer: false,
1042 runtime_dim_upper: vec![],
1043 is_class: false,
1044 logical_kind: None,
1045 last_dim_assumed_size: false,
1046 },
1047 );
1048 continue;
1049 }
1050 // Fall through to the SAVE path if the
1051 // parameter init can't be folded — at least
1052 // semantics are preserved.
1053 }
1054
1055 if let Some(init) = init_expr
1056 .and_then(|e| eval_const_global_init(e, &param_consts, Some(&elem_ty)))
1057 {
1058 let global_name = save_global_name(func_name, &key);
1059 pending_globals.push(PendingGlobal {
1060 global: Global {
1061 name: global_name.clone(),
1062 ty: elem_ty.clone(),
1063 initializer: Some(init),
1064 },
1065 });
1066 let addr = b.global_addr(&global_name, elem_ty.clone());
1067 locals.insert(
1068 key,
1069 LocalInfo {
1070 addr,
1071 ty: elem_ty.clone(),
1072 dims: vec![],
1073 allocatable: false,
1074 descriptor_arg: false,
1075 by_ref: false,
1076 char_kind: CharKind::None,
1077 derived_type: None,
1078 inline_const: None,
1079 is_pointer: false,
1080 runtime_dim_upper: vec![],
1081 is_class: false,
1082 logical_kind: type_spec_logical_kind(type_spec, Some(&param_consts), Some(st)),
1083 last_dim_assumed_size: false,
1084 },
1085 );
1086 } else {
1087 let addr = b.alloca(elem_ty.clone());
1088 locals.insert(
1089 key,
1090 LocalInfo {
1091 addr,
1092 ty: elem_ty.clone(),
1093 dims: vec![],
1094 allocatable: false,
1095 descriptor_arg: false,
1096 by_ref: false,
1097 char_kind: CharKind::None,
1098 derived_type: None,
1099 inline_const: None,
1100 is_pointer: false,
1101 runtime_dim_upper: vec![],
1102 is_class: false,
1103 logical_kind: type_spec_logical_kind(type_spec, Some(&param_consts), Some(st)),
1104 last_dim_assumed_size: false,
1105 },
1106 );
1107 }
1108 }
1109 }
1110 }
1111 }
1112 }
1113