Fortran · 45190 bytes Raw Blame History
1 ! ==============================================================================
2 ! Main Program: Fortran Shell (Fortsh)
3 ! ==============================================================================
4 program fortran_shell
5 use shell_types
6 use system_interface
7 use signal_handler
8 use signal_handling
9 use parser, only: convert_backticks_to_dollar_paren, has_unclosed_quote, ends_with_continuation_backslash, &
10 needs_compound_continuation, remove_line_continuations, process_substitutions
11
12 use grammar_parser ! New grammar-aware parser
13 use ast_executor, only: execute_ast, register_trap_evaluator
14 use command_tree ! Command tree for new parser
15 use executor, only: init_completion_executor, init_control_flow_callbacks
16 use job_control
17 use readline
18 use shell_config
19 use variables, only: get_shell_variable, set_shell_variable
20 use aliases
21 use shell_options
22 use performance
23 use prompt_formatting
24 use command_capture_callback, only: init_command_capture ! For command substitution
25 use builtins, only: init_builtins ! Initialize builtin function pointers
26 use coprocess, only: init_coprocess_registry
27 use version, only: print_version, print_help
28 use iso_fortran_env, only: input_unit, output_unit, error_unit
29 use iso_c_binding, only: c_int
30 implicit none
31
32 type(shell_state_t), allocatable :: shell
33 character(len=16384) :: input_line, proc_subst_line
34 character(len=:), allocatable :: expanded_line, history_expanded
35 character(len=MAX_VAR_VALUE_LEN) :: prompt_str ! Fixed-length to avoid LLVM Flang heap corruption
36 character(len=MAX_VAR_VALUE_LEN) :: rprompt_str ! Right-side prompt (like zsh RPROMPT)
37 character(len=:), allocatable :: rprompt_value ! RPROMPT variable value
38 integer :: iostat, i, num_args
39 character(len=MAX_PATH_LEN) :: arg1, command_string
40 logical :: execute_command_string, execute_script_file, syntax_check_only
41 character(len=:), allocatable :: script_file
42 ! Command duration tracking
43 integer :: cmd_start_time, cmd_end_time, cmd_duration_ms, clock_rate
44 real :: cmd_duration_sec
45 ! New parser infrastructure
46 type(command_node_t), pointer :: ast_root
47 integer :: exit_code
48 character(len=:), allocatable :: converted_line
49 ! Terminal resize support
50 character(len=16) :: cols_str, rows_str
51 logical :: success
52 ! RPROMPT embedding for multi-line prompts
53 integer :: newline_pos, first_line_vlen, rprompt_vlen, rprompt_col
54 character(len=16) :: col_str_buf
55 character(len=2048) :: embedded_prompt
56
57 ! macOS: set S_CTTYREF on controlling terminal to prevent PTY output loss
58 ! (macOS kernel discards slave PTY buffer on child exit without this flag)
59 interface
60 subroutine fortsh_set_cttyref() bind(C, name="fortsh_set_cttyref")
61 end subroutine
62 end interface
63 call fortsh_set_cttyref()
64
65 ! Initialize performance monitoring
66 call init_performance_monitoring()
67
68 ! Silence unused function warning for convert_escape_sequences (kept for future use)
69 if (.false.) input_line = convert_escape_sequences('')
70
71 ! Allocate shell to avoid large stack allocation on macOS
72 allocate(shell)
73
74 ! Initialize these BEFORE initialize_shell since it uses them to check interactivity
75 execute_command_string = .false.
76 execute_script_file = .false.
77 syntax_check_only = .false.
78
79 ! Check for command-line arguments FIRST to detect non-interactive modes
80 num_args = command_argument_count()
81
82 ! Handle command-line arguments for script execution
83 if (num_args > 0) then
84 call get_command_argument(1, arg1)
85
86 ! Check for --version or -v flag
87 if (trim(arg1) == '--version' .or. trim(arg1) == '-v') then
88 call print_version()
89 call c_exit(0_c_int)
90 end if
91
92 ! Check for --help or -h flag
93 if (trim(arg1) == '--help' .or. trim(arg1) == '-h') then
94 call print_help()
95 call c_exit(0_c_int)
96 end if
97
98 ! Check for -n flag (syntax check only, no execution)
99 if (trim(arg1) == '-n') then
100 syntax_check_only = .true.
101 execute_script_file = .true.
102 ! If there's a script file after -n, use it
103 if (num_args >= 2) then
104 if (.not. allocated(script_file)) allocate(character(len=MAX_PATH_LEN) :: script_file)
105 call get_command_argument(2, script_file)
106 execute_script_file = .true.
107 end if
108 ! Check for -c flag (execute command string)
109 else if (trim(arg1) == '-c') then
110 if (num_args >= 2) then
111 call get_command_argument(2, command_string)
112 execute_command_string = .true.
113 ! Note: Additional arguments after command string will be processed
114 ! after shell initialization (to set $0 and positional params)
115 else
116 write(error_unit, '(a)') 'fortsh: -c: option requires an argument'
117 stop 2
118 end if
119 ! Check if it's not a flag (assume it's a script file)
120 else if (arg1(1:1) /= '-') then
121 script_file = trim(arg1)
122 execute_script_file = .true.
123 end if
124 end if
125
126 ! Initialize shell (reads execute_command_string/execute_script_file to set is_interactive)
127 call initialize_shell(shell)
128
129 ! Set option_noexec if -n flag was used
130 if (syntax_check_only) then
131 shell%option_noexec = .true.
132 end if
133
134 ! Initialize builtin function pointers (breaks circular dependency)
135 call init_builtins()
136
137 ! Initialize control flow callbacks (breaks circular dependency)
138 call init_control_flow_callbacks()
139
140 ! Initialize command history (needed even in non-interactive mode)
141 call init_history()
142
143 ! Initialize signal handling module
144 call init_signal_handling(shell)
145
146 ! Register AST evaluator for trap dispatch (breaks executor<->ast_executor circular dep)
147 call register_trap_evaluator()
148
149 ! Initialize command capture callback (for command substitution)
150 call init_command_capture()
151
152 ! Initialize completion function executor callback (for -F completion)
153 call init_completion_executor()
154
155 ! Setup signal handlers if interactive
156 if (shell%is_interactive) then
157 call setup_signal_handlers()
158
159 ! Welcome message for interactive mode
160 write(output_unit, '(a)') 'Welcome to Fortran Shell (fortsh)!'
161 write(output_unit, '(a)') 'Type "help" for available commands or "exit" to quit.'
162 write(output_unit, '(a)') ''
163
164 ! Load configuration file
165 call load_config_file(shell)
166
167 ! Set HISTCONTROL for history management
168 call set_histcontrol(shell%histcontrol)
169
170 ! Load command history from file
171 if (len_trim(shell%histfile) > 0) then
172 call load_history_from_file(trim(shell%histfile), shell%histsize)
173 end if
174 end if
175
176 ! Execute command string if -c was specified
177 if (execute_command_string) then
178 ! Set LINENO to 1 for -c commands (POSIX: lines start at 1)
179 shell%current_line_number = 1
180 ! Mark that we're in command mode (for $- flag)
181 shell%in_command_mode = .true.
182
183 ! POSIX: Handle additional arguments after -c 'command'
184 ! For -c 'command' arg0 arg1 arg2: arg0 becomes $0, arg1 arg2 become $1 $2
185 if (num_args >= 3) then
186 block
187 character(len=MAX_PATH_LEN) :: c_arg
188 integer :: c_idx
189 ! Third argument becomes $0
190 call get_command_argument(3, c_arg)
191 shell%shell_name = trim(c_arg)
192 ! Remaining arguments become positional parameters $1, $2, ...
193 if (num_args >= 4) then
194 shell%num_positional = num_args - 3
195 if (.not. allocated(shell%positional_params)) then
196 allocate(shell%positional_params(shell%num_positional))
197 shell%positional_params_capacity = shell%num_positional
198 else if (shell%positional_params_capacity < shell%num_positional) then
199 deallocate(shell%positional_params)
200 allocate(shell%positional_params(shell%num_positional))
201 shell%positional_params_capacity = shell%num_positional
202 end if
203 do c_idx = 4, num_args
204 call get_command_argument(c_idx, c_arg)
205 shell%positional_params(c_idx - 3)%str = trim(c_arg)
206 end do
207 end if
208 end block
209 end if
210
211 ! Check if string contains heredoc outside quotes and pre-process it
212 if (has_heredoc_outside_quotes(command_string)) then
213 ! Pre-process heredocs before parsing
214 command_string = preprocess_heredocs_for_c(command_string, shell)
215 ! write(error_unit, '(A,A)') 'DEBUG: After preprocess, command_string=', trim(command_string)
216 end if
217
218 ! Handle line continuation (backslash-newline)
219 command_string = remove_line_continuations(command_string)
220 call process_substitutions(shell, trim(command_string), proc_subst_line)
221
222 ! POSIX set -v: Print input line before execution
223 if (shell%option_verbose) then
224 write(error_unit, '(A)') trim(command_string)
225 end if
226
227 ! Parse to AST and execute
228 converted_line = convert_backticks_to_dollar_paren(proc_subst_line)
229 ast_root => parse_command_line(converted_line)
230 if (associated(ast_root)) then
231 exit_code = execute_ast(ast_root, shell)
232 shell%last_exit_status = exit_code
233 call destroy_command_node(ast_root)
234 ! Handle source commands that were the last/only command in -c string
235 if (shell%should_source) then
236 call process_source_file(shell)
237 end if
238 else if (last_parse_had_error) then
239 ! Parse error occurred (not just empty command)
240 shell%last_exit_status = 2
241 end if
242
243 ! Process any sourced files queued by the command
244 if (shell%should_source) then
245 call process_source_file(shell)
246 end if
247
248 ! Execute EXIT trap if one is set (before exiting)
249 call execute_trap_for_signal(shell, 0) ! 0 is TRAP_EXIT
250
251 ! Exit with last command's exit status
252 call c_exit(shell%last_exit_status)
253 end if
254
255 ! Execute script file if specified
256 if (execute_script_file) then
257 shell%source_file = script_file
258 shell%should_source = .true.
259 call process_source_file(shell)
260
261 ! Execute EXIT trap if one is set (before exiting)
262 call execute_trap_for_signal(shell, 0) ! 0 is TRAP_EXIT
263
264 ! Exit with last command's exit status (don't print Goodbye for scripts)
265 if (perf_monitoring_enabled) then
266 call print_performance_stats()
267 end if
268 call cleanup_performance_monitoring()
269 call c_exit(shell%last_exit_status)
270 end if
271
272 ! Main REPL loop
273 do while (shell%running)
274 ! Check for terminal resize (SIGWINCH)
275 if (g_terminal_resized) then
276 g_terminal_resized = .false.
277 ! Re-query terminal dimensions
278 success = get_terminal_size(shell%term_rows, shell%term_cols)
279 ! Update both environment variables (for child processes) and shell variables (for $COLUMNS/$LINES)
280 write(cols_str, '(I0)') shell%term_cols
281 write(rows_str, '(I0)') shell%term_rows
282 success = set_environment_var('COLUMNS', trim(cols_str))
283 success = set_environment_var('LINES', trim(rows_str))
284 call set_shell_variable(shell, 'COLUMNS', trim(cols_str))
285 call set_shell_variable(shell, 'LINES', trim(rows_str))
286 end if
287
288 ! Update job status
289 if (shell%is_interactive) then
290 call update_job_status(shell)
291 call notify_job_status(shell)
292 end if
293
294 ! Process sourced files
295 if (shell%should_source) then
296 call process_source_file(shell)
297 cycle
298 end if
299
300 ! Read input with enhanced readline (includes prompt only if interactive)
301 if (shell%is_interactive) then
302 ! Use safe_expand_prompt to avoid LLVM Flang heap corruption
303 call safe_expand_prompt(shell%ps1, shell, shell%ps1_len, prompt_str)
304
305 ! Get RPROMPT if set (zsh-style right prompt)
306 rprompt_value = get_shell_variable(shell, 'RPROMPT')
307 if (len_trim(rprompt_value) > 0) then
308 call safe_expand_prompt(rprompt_value, shell, len(rprompt_value), rprompt_str)
309
310 ! Check if prompt is multi-line
311 newline_pos = index(trim(prompt_str), char(10))
312 if (newline_pos > 0) then
313 ! Multi-line prompt: embed RPROMPT at end of first line using CHA escape
314 ! This ensures RPROMPT survives readline redraws (unlike cursor movement approach)
315 first_line_vlen = visual_length(prompt_str(1:newline_pos-1))
316 rprompt_vlen = visual_length(trim(rprompt_str))
317 rprompt_col = shell%term_cols - rprompt_vlen + 1
318
319 if (rprompt_col > first_line_vlen + 4) then
320 ! Build: first_line + CHA(col) + rprompt + \n + rest
321 write(col_str_buf, '(I0)') rprompt_col
322 embedded_prompt = prompt_str(1:newline_pos-1) // &
323 char(27) // '[' // trim(col_str_buf) // 'G' // &
324 trim(rprompt_str) // &
325 prompt_str(newline_pos:len_trim(prompt_str))
326 call readline_enhanced(trim(embedded_prompt), input_line, iostat)
327 else
328 ! Not enough space for RPROMPT — skip it
329 call readline_enhanced(trim(prompt_str), input_line, iostat)
330 end if
331 else
332 ! Single-line prompt: pass RPROMPT to readline for its handling
333 call readline_enhanced(trim(prompt_str), input_line, iostat, trim(rprompt_str))
334 end if
335 else
336 call readline_enhanced(trim(prompt_str), input_line, iostat)
337 end if
338 else
339 read(input_unit, '(a)', iostat=iostat) input_line
340 ! Note: History will be added after expansion below
341 end if
342
343 ! Check for terminal resize that may have occurred during readline
344 ! (SIGWINCH can arrive while waiting for input)
345 if (g_terminal_resized) then
346 g_terminal_resized = .false.
347 success = get_terminal_size(shell%term_rows, shell%term_cols)
348 write(cols_str, '(I0)') shell%term_cols
349 write(rows_str, '(I0)') shell%term_rows
350 success = set_environment_var('COLUMNS', trim(cols_str))
351 success = set_environment_var('LINES', trim(rows_str))
352 call set_shell_variable(shell, 'COLUMNS', trim(cols_str))
353 call set_shell_variable(shell, 'LINES', trim(rows_str))
354 end if
355
356 ! Check for EOF (Ctrl-D)
357 if (iostat /= 0) then
358 ! Only print newline in interactive mode for clean exit
359 if (shell%is_interactive) then
360 write(output_unit, '(a)') ''
361 end if
362 exit
363 end if
364
365 ! Skip empty lines
366 if (len_trim(input_line) == 0) cycle
367
368 ! Check for unclosed quotes or backslash continuation and continue reading
369 do while (has_unclosed_quote(input_line) .or. ends_with_continuation_backslash(input_line))
370 if (shell%is_interactive) then
371 ! Full readline with PS2 prompt expansion
372 prompt_str = expand_prompt(shell%ps2, shell, shell%ps2_len)
373 call readline_enhanced(prompt_str, proc_subst_line, iostat)
374 else
375 ! Non-interactive: just read next line
376 read(input_unit, '(a)', iostat=iostat) proc_subst_line
377 end if
378
379 ! Check for EOF during continuation
380 if (iostat /= 0) then
381 ! Only print newline in interactive mode for clean exit
382 if (shell%is_interactive) then
383 write(output_unit, '(a)') ''
384 end if
385 exit
386 end if
387
388 ! Append the continuation line with a newline character
389 input_line = trim(input_line) // char(10) // trim(proc_subst_line)
390 end do
391
392 ! Handle line continuation (backslash-newline)
393 input_line = remove_line_continuations(input_line)
394
395 ! Check for unclosed compound commands (if/fi, do/done, case/esac)
396 do while (needs_compound_continuation(input_line))
397 if (shell%is_interactive) then
398 ! Full readline with PS2 prompt expansion
399 prompt_str = expand_prompt(shell%ps2, shell, shell%ps2_len)
400 call readline_enhanced(prompt_str, proc_subst_line, iostat)
401 else
402 ! Non-interactive: just read next line
403 read(input_unit, '(a)', iostat=iostat) proc_subst_line
404 end if
405
406 ! Check for EOF during compound continuation
407 if (iostat /= 0) then
408 if (shell%is_interactive) then
409 write(output_unit, '(a)') ''
410 end if
411 exit
412 end if
413
414 ! Append the continuation line with a newline character
415 input_line = trim(input_line) // char(10) // trim(proc_subst_line)
416 end do
417
418 ! Expand history (!!, !n, !string, etc.) if needed
419 if (needs_history_expansion(input_line)) then
420 history_expanded = expand_history(input_line)
421 ! Print expanded command if interactive (like bash does)
422 if (shell%is_interactive) then
423 write(output_unit, '(a)') trim(history_expanded)
424 end if
425 ! Add the EXPANDED command to history (not the original !!)
426 call add_to_history(history_expanded)
427 ! Now expand aliases on the history-expanded line
428 call expand_alias(shell, trim(history_expanded), expanded_line)
429 else
430 ! No history expansion needed, add original line to history
431 call add_to_history(input_line)
432 ! Then expand aliases
433 call expand_alias(shell, trim(input_line), expanded_line)
434 end if
435
436 ! Process substitutions <() and >() before parsing
437 call process_substitutions(shell, expanded_line, proc_subst_line)
438
439 ! POSIX set -v: Print input line before execution
440 if (shell%option_verbose) then
441 write(error_unit, '(A)') trim(expanded_line)
442 end if
443
444 ! Parse and execute via AST
445 call system_clock(cmd_start_time, clock_rate)
446
447 converted_line = convert_backticks_to_dollar_paren(proc_subst_line)
448 ast_root => parse_command_line(converted_line)
449 if (associated(ast_root)) then
450 ! Store current command for job descriptions
451 shell%current_command = converted_line
452
453 ! POSIX: In noexec mode, parse but don't execute (ignored in interactive shells)
454 if (shell%option_noexec .and. .not. shell%is_interactive) then
455 shell%last_exit_status = 0
456 exit_code = 0
457 else
458 exit_code = execute_ast(ast_root, shell)
459 shell%last_exit_status = exit_code
460 end if
461
462 ! Flush output after command execution — flang-new buffers Fortran I/O
463 ! and won't flush to PTY until the buffer fills or process exits.
464 ! Without this, interactive output appears delayed or missing.
465 flush(output_unit)
466 flush(error_unit)
467
468 call destroy_command_node(ast_root)
469
470 ! Calculate and display duration if > 1 second
471 call system_clock(cmd_end_time)
472 cmd_duration_ms = (cmd_end_time - cmd_start_time) * 1000 / clock_rate
473 cmd_duration_sec = real(cmd_duration_ms) / 1000.0
474
475 if (shell%is_interactive .and. cmd_duration_sec >= 1.0) then
476 if (shell%term_supports_color) then
477 write(output_unit, '(a,f0.1,a)') char(27) // '[2m' // 'Executed in ', &
478 cmd_duration_sec, 's' // char(27) // '[0m'
479 else
480 write(output_unit, '(a,f0.1,a)') 'Executed in ', cmd_duration_sec, 's'
481 end if
482 end if
483
484 ! Update terminal title after command execution
485 if (shell%is_interactive .and. shell%term_supports_color) then
486 call set_terminal_title(trim(shell%username) // '@' // trim(shell%hostname) // ': ' // trim(shell%cwd))
487 end if
488
489 ! Increment command number for next prompt
490 shell%command_number = shell%command_number + 1
491 call increment_prompt_history()
492 else if (last_parse_had_error) then
493 shell%last_exit_status = 2
494 end if
495 end do
496
497 ! Execute EXIT trap if one is set
498 call execute_trap_for_signal(shell, 0) ! 0 is TRAP_EXIT
499
500 ! Save command history to file (only in interactive mode)
501 if (shell%is_interactive .and. len_trim(shell%histfile) > 0 .and. get_history_count() > 0) then
502 call save_history_to_file(trim(shell%histfile), shell%histfilesize)
503 end if
504
505 ! Run logout scripts if this is a login shell
506 if (shell%is_login_shell) then
507 call run_logout_scripts(shell)
508 end if
509
510 ! Print performance statistics if monitoring was enabled
511 if (perf_monitoring_enabled) then
512 call print_performance_stats()
513 end if
514
515 ! Cleanup performance monitoring
516 call cleanup_performance_monitoring()
517
518 ! Only print goodbye message in interactive mode
519 if (shell%is_interactive) then
520 write(output_unit, '(a)') 'Goodbye!'
521 end if
522
523 ! Exit with the last command's exit status (preserves exit code from EXIT trap)
524 call c_exit(shell%last_exit_status)
525
526 contains
527
528 ! Remove backslash-newline line continuations from input
529
530 ! Convert escape sequences like \n to actual characters for -c flag
531 function convert_escape_sequences(input) result(output)
532 character(len=*), intent(in) :: input
533 character(len=len(input)*2) :: output ! Worst case: all chars become newlines
534 integer :: i, j
535
536 output = ''
537 i = 1
538 j = 1
539
540 do while (i <= len_trim(input))
541 ! Check for backslash escape sequences
542 if (i < len_trim(input) .and. input(i:i) == '\') then
543 select case(input(i+1:i+1))
544 case('n')
545 ! Convert \n to actual newline
546 output(j:j) = char(10)
547 i = i + 2
548 j = j + 1
549 case('t')
550 ! Convert \t to tab
551 output(j:j) = char(9)
552 i = i + 2
553 j = j + 1
554 case('\')
555 ! Convert \\ to single backslash
556 output(j:j) = '\'
557 i = i + 2
558 j = j + 1
559 case default
560 ! Keep backslash and next char as-is
561 output(j:j) = input(i:i)
562 j = j + 1
563 i = i + 1
564 end select
565 else
566 ! Regular character, copy as-is
567 output(j:j) = input(i:i)
568 i = i + 1
569 j = j + 1
570 end if
571 end do
572 end function
573
574 ! Check if a string contains heredoc syntax (<<) outside of quotes
575 function has_heredoc_outside_quotes(str) result(has_heredoc)
576 character(len=*), intent(in) :: str
577 logical :: has_heredoc
578 integer :: i
579 logical :: in_single_quote, in_double_quote
580 character :: ch
581
582 has_heredoc = .false.
583 in_single_quote = .false.
584 in_double_quote = .false.
585
586 do i = 1, len_trim(str) - 1
587 ch = str(i:i)
588
589 ! Track quote state
590 if (.not. in_double_quote .and. ch == "'") then
591 in_single_quote = .not. in_single_quote
592 else if (.not. in_single_quote .and. ch == '"') then
593 in_double_quote = .not. in_double_quote
594 end if
595
596 ! Check for << when outside quotes
597 if (.not. in_single_quote .and. .not. in_double_quote) then
598 if (str(i:i+1) == '<<') then
599 has_heredoc = .true.
600 return
601 end if
602 end if
603 end do
604 end function
605
606 ! Check if input has unclosed compound commands that need more lines
607 ! Uses the lexer to properly distinguish keywords from arguments
608
609 ! Pre-process heredocs in -c commands
610 ! Extracts heredoc content and stores it for later use
611 function preprocess_heredocs_for_c(input, shell) result(output)
612 use shell_types
613 use iso_fortran_env, only: error_unit
614 character(len=*), intent(in) :: input
615 type(shell_state_t), intent(inout) :: shell
616 character(len=len(input)*2) :: output
617 integer :: i, j, k, cmd_line_end, content_pos
618 integer :: delim_start, delim_end, content_start, content_end
619 character(len=256) :: delimiter, delimiters(MAX_PENDING_HEREDOCS)
620 logical :: quoted_delimiters(MAX_PENDING_HEREDOCS), strip_tabs_arr(MAX_PENDING_HEREDOCS)
621 integer :: num_heredocs, heredoc_idx
622 character(len=4096) :: heredoc_content
623 logical :: quoted_delimiter, strip_tabs
624 character(len=len(input)) :: cmd_line
625
626 output = input ! Start with original
627
628 ! Find the first newline - everything before is the command line
629 cmd_line_end = index(input, char(10))
630 if (cmd_line_end == 0) then
631 ! No newline means no heredoc content
632 return
633 end if
634
635 cmd_line = input(1:cmd_line_end-1)
636
637 ! Count and collect all heredoc delimiters from the command line
638 ! Only match << when it's outside quotes
639 num_heredocs = 0
640 i = 1
641 do while (i <= len_trim(cmd_line))
642 ! Find next << outside of quotes
643 j = 0
644 block
645 integer :: search_pos
646 logical :: in_single_quote, in_double_quote
647 character :: ch
648
649 in_single_quote = .false.
650 in_double_quote = .false.
651 search_pos = i
652
653 do while (search_pos <= len_trim(cmd_line) - 1)
654 ch = cmd_line(search_pos:search_pos)
655
656 ! Track quote state
657 if (.not. in_double_quote .and. ch == "'") then
658 in_single_quote = .not. in_single_quote
659 else if (.not. in_single_quote .and. ch == '"') then
660 in_double_quote = .not. in_double_quote
661 end if
662
663 ! Check for << when outside quotes
664 if (.not. in_single_quote .and. .not. in_double_quote) then
665 if (cmd_line(search_pos:search_pos+1) == '<<') then
666 j = search_pos
667 exit
668 end if
669 end if
670
671 search_pos = search_pos + 1
672 end do
673 end block
674
675 if (j == 0) exit
676
677 ! Check for <<- (strip tabs)
678 strip_tabs = .false.
679 if (j + 2 <= len_trim(cmd_line) .and. cmd_line(j+2:j+2) == '-') then
680 strip_tabs = .true.
681 k = j + 3
682 else
683 k = j + 2
684 end if
685
686 ! Skip spaces after << or <<-
687 do while (k <= len_trim(cmd_line) .and. cmd_line(k:k) == ' ')
688 k = k + 1
689 end do
690
691 if (k > len_trim(cmd_line)) exit
692
693 ! Check for quoted delimiter
694 quoted_delimiter = .false.
695 if (cmd_line(k:k) == "'" .or. cmd_line(k:k) == '"') then
696 quoted_delimiter = .true.
697 block
698 character :: quote_char
699 quote_char = cmd_line(k:k)
700 k = k + 1
701 delim_start = k
702 ! Find closing quote
703 delim_end = k
704 do while (delim_end <= len_trim(cmd_line) .and. cmd_line(delim_end:delim_end) /= quote_char)
705 delim_end = delim_end + 1
706 end do
707 delim_end = delim_end - 1
708 end block
709 else
710 delim_start = k
711 ! Find end of delimiter (space, semicolon, or end of line)
712 delim_end = k
713 do while (delim_end <= len_trim(cmd_line) .and. &
714 cmd_line(delim_end:delim_end) /= ' ' .and. &
715 cmd_line(delim_end:delim_end) /= ';')
716 delim_end = delim_end + 1
717 end do
718 delim_end = delim_end - 1
719 end if
720
721 if (delim_end >= delim_start .and. num_heredocs < MAX_PENDING_HEREDOCS) then
722 num_heredocs = num_heredocs + 1
723 delimiters(num_heredocs) = cmd_line(delim_start:delim_end)
724 quoted_delimiters(num_heredocs) = quoted_delimiter
725 strip_tabs_arr(num_heredocs) = strip_tabs
726 end if
727
728 i = delim_end + 1
729 if (quoted_delimiter) i = i + 1 ! Skip closing quote
730 end do
731
732 if (num_heredocs == 0) return
733
734 ! Now extract content for each heredoc in order
735 content_pos = cmd_line_end + 1 ! Start after the command line newline
736
737 do heredoc_idx = 1, num_heredocs
738 delimiter = trim(delimiters(heredoc_idx))
739 strip_tabs = strip_tabs_arr(heredoc_idx)
740
741 ! Find content until the delimiter
742 content_start = content_pos
743 content_end = 0
744
745 j = content_pos
746 do while (j <= len_trim(input))
747 ! Check if we're at start of a line
748 if (j == content_pos .or. input(j-1:j-1) == char(10)) then
749 ! For <<-, skip leading tabs before checking delimiter
750 k = j
751 if (strip_tabs) then
752 do while (k <= len_trim(input) .and. input(k:k) == char(9))
753 k = k + 1
754 end do
755 end if
756 ! Check if this line starts with the delimiter (after tabs if strip_tabs)
757 if (k + len_trim(delimiter) - 1 <= len_trim(input)) then
758 if (input(k:k+len_trim(delimiter)-1) == trim(delimiter)) then
759 ! Check if delimiter is alone on the line or followed by newline
760 if (k + len_trim(delimiter) > len_trim(input) .or. &
761 input(k+len_trim(delimiter):k+len_trim(delimiter)) == char(10)) then
762 content_end = j - 1
763 content_pos = k + len_trim(delimiter)
764 if (content_pos <= len_trim(input) .and. &
765 input(content_pos:content_pos) == char(10)) then
766 content_pos = content_pos + 1
767 end if
768 exit
769 end if
770 end if
771 end if
772 end if
773 j = j + 1
774 end do
775
776 ! Extract heredoc content
777 if (content_end >= content_start) then
778 heredoc_content = input(content_start:content_end)
779 else
780 heredoc_content = ''
781 end if
782
783 ! Strip leading tabs if requested
784 if (strip_tabs) then
785 block
786 integer :: m, n
787 character(len=4096) :: stripped_content
788 logical :: at_line_start
789
790 stripped_content = ''
791 m = 1
792 n = 1
793 at_line_start = .true.
794
795 do while (m <= len_trim(heredoc_content))
796 if (at_line_start .and. heredoc_content(m:m) == char(9)) then
797 ! Skip leading tab
798 m = m + 1
799 else
800 ! Copy character
801 at_line_start = .false.
802 stripped_content(n:n) = heredoc_content(m:m)
803 if (heredoc_content(m:m) == char(10)) then
804 at_line_start = .true.
805 end if
806 n = n + 1
807 m = m + 1
808 end if
809 end do
810
811 heredoc_content = stripped_content
812 end block
813 end if
814
815 ! Store in pending heredocs array
816 shell%pending_heredocs(heredoc_idx)%content = trim(heredoc_content)
817 shell%pending_heredocs(heredoc_idx)%delimiter = trim(delimiter)
818 shell%pending_heredocs(heredoc_idx)%quoted = quoted_delimiters(heredoc_idx)
819 shell%pending_heredocs(heredoc_idx)%strip_tabs = strip_tabs
820 end do
821
822 shell%num_pending_heredocs = num_heredocs
823 shell%next_pending_heredoc = 1
824
825 ! Also set legacy single heredoc for backward compatibility
826 if (num_heredocs >= 1) then
827 shell%pending_heredoc = shell%pending_heredocs(1)%content
828 shell%pending_heredoc_delimiter = shell%pending_heredocs(1)%delimiter
829 shell%pending_heredoc_quoted = shell%pending_heredocs(1)%quoted
830 shell%pending_heredoc_strip_tabs = shell%pending_heredocs(1)%strip_tabs
831 shell%has_pending_heredoc = .true.
832 end if
833
834 ! Return the command line plus any remaining commands after heredocs
835 if (content_pos <= len_trim(input)) then
836 ! There are more commands after the last heredoc
837 output = trim(cmd_line) // char(10) // trim(input(content_pos:))
838 else
839 output = cmd_line
840 end if
841
842 end function
843
844 subroutine run_logout_scripts(shell)
845 type(shell_state_t), intent(inout) :: shell
846 character(len=:), allocatable :: home_dir, logout_file
847 logical :: file_exists
848
849 home_dir = get_environment_var('HOME')
850 if (len(home_dir) == 0) return
851
852 ! Execute ~/.fortsh_logout if it exists
853 logout_file = trim(home_dir) // '/.fortsh_logout'
854 inquire(file=logout_file, exist=file_exists)
855
856 if (file_exists) then
857 ! Source the logout file
858 shell%source_file = logout_file
859 shell%should_source = .true.
860 call process_source_file(shell)
861 end if
862 end subroutine
863
864
865 recursive subroutine process_source_file(shell)
866 use grammar_parser, only: parse_command_line, last_parse_had_error
867 use command_tree, only: destroy_command_node, command_node_t
868 use ast_executor, only: execute_ast
869 type(shell_state_t), intent(inout) :: shell
870 character(len=16384) :: input_line, proc_subst_line, converted_line
871 character(len=16384) :: continuation_line
872 integer :: file_unit, iostat, exit_code
873 type(command_node_t), pointer :: ast_root
874 character(len=:), allocatable :: expanded_line, history_expanded
875
876 ! Reset the source flag first
877 shell%should_source = .false.
878
879 ! Open file for reading
880 open(newunit=file_unit, file=trim(shell%source_file), status='old', action='read', iostat=iostat)
881 if (iostat /= 0) then
882 write(error_unit, '(a)') 'source: failed to open ' // trim(shell%source_file)
883 shell%last_exit_status = 1
884 return
885 end if
886
887 ! Increment source depth for return tracking
888 shell%source_depth = shell%source_depth + 1
889
890 ! Execute each line in the file
891 do
892 read(file_unit, '(a)', iostat=iostat) input_line
893 if (iostat /= 0) exit ! End of file or error
894
895 ! Skip empty lines and comments
896 if (len_trim(input_line) == 0 .or. input_line(1:1) == '#') cycle
897
898 ! Check for unclosed quotes or backslash continuation
899 do while (has_unclosed_quote(input_line) .or. ends_with_continuation_backslash(input_line))
900 read(file_unit, '(a)', iostat=iostat) continuation_line
901 if (iostat /= 0) exit ! End of file during continuation
902 ! Append the continuation line with a newline character
903 input_line = trim(input_line) // char(10) // trim(continuation_line)
904 end do
905
906 ! Handle line continuation (backslash-newline)
907 input_line = remove_line_continuations(input_line)
908
909 ! If EOF was reached during continuation, exit
910 if (iostat /= 0) exit
911
912 ! Check for unclosed compound commands (if/fi, do/done, case/esac)
913 do while (needs_compound_continuation(input_line))
914 read(file_unit, '(a)', iostat=iostat) continuation_line
915 if (iostat /= 0) exit ! End of file during compound command
916 ! Skip comment-only continuation lines but still append them
917 input_line = trim(input_line) // char(10) // trim(continuation_line)
918 end do
919
920 ! If EOF was reached during compound continuation, still try to parse what we have
921 ! (the parser will report a syntax error for incomplete commands)
922
923 ! Function definitions and all compound commands are now accumulated by
924 ! needs_compound_continuation above and parsed via the AST parser.
925
926 ! Normal line processing
927 ! Expand history if needed, then expand aliases
928 ! NOTE: We do NOT add sourced file commands to history (only interactive commands)
929 if (needs_history_expansion(input_line)) then
930 history_expanded = expand_history(input_line)
931 call expand_alias(shell, trim(history_expanded), expanded_line)
932 else
933 call expand_alias(shell, trim(input_line), expanded_line)
934 end if
935
936 ! Process substitutions <() and >() before parsing
937 call process_substitutions(shell, expanded_line, proc_subst_line)
938
939 ! POSIX set -v: Print input line before execution
940 if (shell%option_verbose) then
941 write(error_unit, '(A)') trim(input_line)
942 end if
943
944 ! Parse and execute via AST
945 converted_line = convert_backticks_to_dollar_paren(proc_subst_line)
946 ast_root => parse_command_line(converted_line)
947 if (associated(ast_root)) then
948 if (shell%option_noexec) then
949 exit_code = 0
950 shell%last_exit_status = 0
951 else
952 exit_code = execute_ast(ast_root, shell)
953 shell%last_exit_status = exit_code
954 end if
955
956 ! Handle nested source commands (e.g., script calls source)
957 if (shell%should_source) then
958 call process_source_file(shell)
959 end if
960 else if (last_parse_had_error) then
961 shell%last_exit_status = 2
962 end if
963
964 ! Stop execution if exit command was encountered
965 if (.not. shell%running) then
966 exit
967 end if
968
969 ! Stop execution if return was called from sourced script
970 if (shell%function_return_pending .and. shell%source_depth > 0) exit
971 end do
972
973 ! Fire RETURN trap if set (after sourced script finishes)
974 block
975 use signal_handling, only: get_trap_command, TRAP_RETURN
976 use ast_executor, only: execute_ast_node
977 character(len=4096) :: src_return_cmd
978 src_return_cmd = get_trap_command(shell, TRAP_RETURN)
979 if (len_trim(src_return_cmd) > 0 .and. &
980 .not. shell%executing_trap) then
981 block
982 type(command_node_t), pointer :: trap_node
983 integer :: saved_status_src
984 logical :: saved_bypass_src
985 saved_status_src = shell%last_exit_status
986 saved_bypass_src = shell%bypass_functions
987 shell%bypass_functions = .false.
988 shell%executing_trap = .true.
989 trap_node => parse_command_line(trim(src_return_cmd))
990 if (associated(trap_node)) then
991 exit_code = execute_ast_node(trap_node, shell)
992 call destroy_command_node(trap_node)
993 end if
994 shell%executing_trap = .false.
995 shell%bypass_functions = saved_bypass_src
996 shell%last_exit_status = saved_status_src
997 end block
998 end if
999 end block
1000
1001 ! Decrement source depth
1002 shell%source_depth = shell%source_depth - 1
1003
1004 ! Clear the return flag if we're exiting due to return in sourced script
1005 if (shell%function_return_pending .and. shell%function_depth == 0) then
1006 shell%function_return_pending = .false.
1007 end if
1008
1009 close(file_unit)
1010 shell%source_file = ''
1011 end subroutine
1012
1013 subroutine initialize_shell(shell)
1014 type(shell_state_t), intent(out) :: shell
1015 character(len=:), allocatable :: temp
1016 character(kind=c_char), target :: c_hostname(256)
1017 character(len=256) :: arg
1018 character(len=16) :: cols_str, rows_str
1019 integer :: ret, i, num_args
1020 logical :: success
1021
1022 ! Initialize allocatable arrays to avoid large stack allocation on macOS
1023 if (.not. allocated(shell%positional_params)) then
1024 allocate(shell%positional_params(50))
1025 shell%positional_params_capacity = 50
1026 do i = 1, 50
1027 shell%positional_params(i)%str = ''
1028 end do
1029 end if
1030 if (.not. allocated(shell%local_vars)) then
1031 allocate(shell%local_vars(MAX_CONTROL_DEPTH, MAX_LOCAL_VARS_PER_SCOPE))
1032 end if
1033 if (.not. allocated(shell%local_var_counts)) then
1034 allocate(shell%local_var_counts(MAX_CONTROL_DEPTH))
1035 shell%local_var_counts = 0
1036 end if
1037
1038 ! Detect if this is a login shell
1039 ! Check if argv[0] starts with '-' or if --login flag is present
1040 shell%is_login_shell = .false.
1041 num_args = command_argument_count()
1042
1043 ! Check argv[0] (program name)
1044 if (num_args >= 0) then
1045 call get_command_argument(0, arg)
1046 ! If program name starts with '-', it's a login shell
1047 if (len_trim(arg) > 0 .and. arg(1:1) == '-') then
1048 shell%is_login_shell = .true.
1049 end if
1050 end if
1051
1052 ! Check for --login flag
1053 do i = 1, num_args
1054 call get_command_argument(i, arg)
1055 if (trim(arg) == '--login' .or. trim(arg) == '-l') then
1056 shell%is_login_shell = .true.
1057 exit
1058 end if
1059 end do
1060
1061 ! Get username
1062 temp = get_environment_var('USER')
1063 if (len(temp) > 0) then
1064 shell%username = temp
1065 else
1066 shell%username = 'user'
1067 end if
1068
1069 ! Get hostname
1070 ret = c_gethostname(c_loc(c_hostname), 256_c_size_t)
1071 if (ret == 0) then
1072 shell%hostname = ''
1073 do i = 1, 256
1074 if (c_hostname(i) == c_null_char) exit
1075 shell%hostname(i:i) = c_hostname(i)
1076 end do
1077 else
1078 shell%hostname = 'localhost'
1079 end if
1080
1081 ! Get current directory
1082 shell%cwd = get_current_directory()
1083
1084 ! Check if shell is interactive (only if not already set by -c or script file)
1085 ! If execute_command_string or execute_script_file is true, we already set is_interactive = false
1086 if (.not. execute_command_string .and. .not. execute_script_file) then
1087 shell%is_interactive = (c_isatty(STDIN_FD) /= 0)
1088 end if
1089
1090 ! Setup job control if interactive
1091 if (shell%is_interactive) then
1092 shell%shell_pgid = c_getpid()
1093 ret = c_setpgid(shell%shell_pgid, shell%shell_pgid)
1094 shell%shell_terminal = STDIN_FD
1095 ret = c_tcsetpgrp(shell%shell_terminal, shell%shell_pgid)
1096 ! Enable monitor mode (job control) for interactive shells
1097 shell%option_monitor = .true.
1098 end if
1099
1100 ! Query terminal size (only if interactive to avoid SIGTTOU)
1101 if (shell%is_interactive) then
1102 success = get_terminal_size(shell%term_rows, shell%term_cols)
1103 ! Set COLUMNS and LINES in both environment and shell variables
1104 write(cols_str, '(I0)') shell%term_cols
1105 write(rows_str, '(I0)') shell%term_rows
1106 success = set_environment_var('COLUMNS', trim(cols_str))
1107 success = set_environment_var('LINES', trim(rows_str))
1108 call set_shell_variable(shell, 'COLUMNS', trim(cols_str))
1109 call set_shell_variable(shell, 'LINES', trim(rows_str))
1110 end if
1111
1112 ! Check terminal capabilities (ANSI support) - only if interactive
1113 if (shell%is_interactive) then
1114 shell%term_supports_color = terminal_supports_ansi()
1115 else
1116 shell%term_supports_color = .false.
1117 end if
1118
1119 ! Set initial terminal title if interactive (only for ANSI terminals)
1120 if (shell%is_interactive .and. shell%term_supports_color) then
1121 call set_terminal_title(trim(shell%username) // '@' // trim(shell%hostname) // ': ' // trim(shell%cwd))
1122 end if
1123
1124 ! Initialize other fields
1125 shell%last_exit_status = 0
1126 shell%last_pid = 0
1127 shell%running = .true.
1128 shell%num_jobs = 0
1129 shell%next_job_id = 1
1130
1131 ! Initialize history control variables
1132 temp = get_environment_var('HOME')
1133 if (len(temp) > 0) then
1134 shell%histfile = trim(temp) // '/.fortsh_history'
1135 else
1136 shell%histfile = ''
1137 end if
1138 shell%histsize = 1000
1139 shell%histfilesize = 2000
1140 shell%histcontrol = 'ignoredups' ! Default: ignore duplicate consecutive commands
1141
1142 ! Initialize shell options and special variables
1143 call initialize_shell_options(shell)
1144
1145 ! Save original stderr for shell messages (xtrace, errors, etc.)
1146 ! This ensures shell meta-output isn't affected by command redirections
1147 shell%original_stderr_fd = c_dup(STDERR_FD)
1148 if (shell%original_stderr_fd < 0) then
1149 shell%original_stderr_fd = STDERR_FD ! Fallback if dup fails
1150 end if
1151
1152 ! Initialize special shell variables
1153 shell%uid = get_uid()
1154 shell%euid = get_euid()
1155 call system_clock(shell%shell_start_time)
1156 shell%oldpwd = ''
1157 shell%last_arg = ''
1158 shell%pending_trap_command = ''
1159 shell%current_command = ''
1160 shell%ps1 = '%F{green}\u@\h%f :: %F{blue}\w%f\n> '
1161 shell%current_line_number = 0
1162
1163 ! Initialize jobs array
1164 do i = 1, MAX_JOBS
1165 shell%jobs(i)%job_id = 0
1166 end do
1167
1168 ! Initialize aliases array
1169 do i = 1, size(shell%aliases)
1170 shell%aliases(i)%name = ''
1171 shell%aliases(i)%command = ''
1172 end do
1173
1174 ! Initialize traps array
1175 do i = 1, size(shell%traps)
1176 shell%traps(i)%command = ''
1177 end do
1178
1179 ! Initialize control stack
1180 do i = 1, size(shell%control_stack)
1181 shell%control_stack(i)%condition_cmd = ''
1182 end do
1183
1184 ! Initialize coprocess registry (module-level, not part of shell_state_t)
1185 call init_coprocess_registry()
1186
1187 ! Initialize functions array
1188 do i = 1, size(shell%functions)
1189 shell%functions(i)%name = ''
1190 shell%functions(i)%body_lines = 0
1191 end do
1192
1193 ! Initialize prompt string lengths (to match default values in shell_state_t)
1194 shell%ps1_len = len_trim(shell%ps1) ! '\u@\h :: \w > ' = 17 chars
1195 shell%ps2_len = 2 ! '> ' = 2 chars (don't trim trailing space)
1196 shell%ps3_len = 3 ! '#? ' = 3 chars (don't trim trailing space)
1197 shell%ps4_len = 2 ! '+ ' = 2 chars (don't trim trailing space)
1198
1199 ! Check for performance monitoring environment variable
1200 temp = get_environment_var('FORTSH_PERF')
1201 if (len(temp) > 0 .and. trim(temp) == '1') then
1202 call set_performance_monitoring(.true.)
1203 end if
1204
1205 end subroutine
1206
1207 subroutine execute_trap_for_signal(shell, signum)
1208 use grammar_parser, only: parse_command_line, last_parse_had_error
1209 use ast_executor, only: execute_ast_node
1210 use command_tree, only: command_node_t, destroy_command_node
1211 type(shell_state_t), intent(inout) :: shell
1212 integer, intent(in) :: signum
1213 character(len=4096) :: trap_command
1214 type(command_node_t), pointer :: trap_ast
1215 integer :: saved_exit_status, trap_exit_code
1216
1217 ! Get the trap command for this signal
1218 trap_command = get_trap_command(shell, signum)
1219
1220 if (len_trim(trap_command) == 0) return
1221
1222 ! Don't execute inherited traps (visible in subshell but not executed)
1223 if (is_trap_inherited(shell, signum)) return
1224
1225 ! Save current exit status (trap should not affect $?)
1226 saved_exit_status = shell%last_exit_status
1227
1228 ! Don't execute trap if we're already in one
1229 if (shell%executing_trap) return
1230
1231 ! Don't execute EXIT trap if it was already executed by builtin_exit
1232 if (signum == 0 .and. shell%exit_trap_executed) return
1233
1234 ! Set flag to prevent recursive trap execution
1235 shell%executing_trap = .true.
1236
1237 ! Mark EXIT trap as executed if this is an EXIT trap
1238 if (signum == 0) shell%exit_trap_executed = .true.
1239
1240 ! Parse and execute trap command via AST
1241 trap_ast => parse_command_line(trim(trap_command))
1242 if (associated(trap_ast)) then
1243 trap_exit_code = execute_ast_node(trap_ast, shell)
1244 call destroy_command_node(trap_ast)
1245 else if (last_parse_had_error) then
1246 shell%last_exit_status = 2
1247 end if
1248
1249 ! Clear flag
1250 shell%executing_trap = .false.
1251
1252 ! Restore exit status
1253 shell%last_exit_status = saved_exit_status
1254 end subroutine
1255
1256 end program fortran_shell