diff --git a/include/cyclone/runtime.h b/include/cyclone/runtime.h index 0d4ac141..3c61e5fc 100644 --- a/include/cyclone/runtime.h +++ b/include/cyclone/runtime.h @@ -391,6 +391,7 @@ extern const object primitive_bytevector_91u8_91set_67; extern const object primitive_string_91ref; extern const object primitive_string_91set_67; extern const object primitive_Cyc_91installation_91dir; +extern const object primitive_Cyc_91compilation_91environment; extern const object primitive_command_91line_91arguments; extern const object primitive_system; extern const object primitive_boolean_127; diff --git a/runtime.c b/runtime.c index f2bf7cb0..563e3a49 100644 --- a/runtime.c +++ b/runtime.c @@ -3189,6 +3189,12 @@ void _Cyc_91installation_91dir(void *data, object cont, object args) Cyc_installation_dir(data, cont, car(args)); } +void _Cyc_91compilation_91environment(void *data, object cont, object args) +{ + Cyc_check_num_args(data, "Cyc-compilation-environment", 1, args); + Cyc_compilation_environment(data, cont, car(args)); +} + void _command_91line_91arguments(void *data, object cont, object args) { object cmdline = Cyc_command_line_arguments(data, cont); @@ -4132,6 +4138,8 @@ static primitive_type string_91set_67_primitive = { {0}, primitive_tag, "string-set!", &_cyc_string_91set_67 }; static primitive_type Cyc_91installation_91dir_primitive = { {0}, primitive_tag, "Cyc-installation-dir", &_Cyc_91installation_91dir }; +static primitive_type Cyc_91compilation_91environment_primitive = + { {0}, primitive_tag, "Cyc-compilation-environment", &_Cyc_91compilation_91environment }; static primitive_type command_91line_91arguments_primitive = { {0}, primitive_tag, "command-line-arguments", &_command_91line_91arguments @@ -4325,6 +4333,8 @@ const object primitive_string_91ref = &string_91ref_primitive; const object primitive_string_91set_67 = &string_91set_67_primitive; const object primitive_Cyc_91installation_91dir = &Cyc_91installation_91dir_primitive; +const object primitive_Cyc_91compilation_91environment = + &Cyc_91compilation_91environment_primitive; const object primitive_command_91line_91arguments = &command_91line_91arguments_primitive; const object primitive_system = &system_primitive; diff --git a/scheme/cyclone/cps-optimizations.sld b/scheme/cyclone/cps-optimizations.sld index f4f42502..c82ecde5 100644 --- a/scheme/cyclone/cps-optimizations.sld +++ b/scheme/cyclone/cps-optimizations.sld @@ -532,6 +532,7 @@ bytevector bytevector-append bytevector-copy string->utf8 number->string symbol->string list->string utf8->string string-append string substring Cyc-installation-dir read-line + Cyc-compilation-environment ))) ;; Check each pair of primitive call / corresponding lambda arg, diff --git a/scheme/cyclone/primitives.sld b/scheme/cyclone/primitives.sld index 8bb33f2c..aa5dab64 100644 --- a/scheme/cyclone/primitives.sld +++ b/scheme/cyclone/primitives.sld @@ -72,6 +72,7 @@ system command-line-arguments Cyc-installation-dir + Cyc-compilation-environment Cyc-default-exception-handler Cyc-current-exception-handler cons @@ -188,6 +189,7 @@ (system 1 1) (command-line-arguments 0 0) (Cyc-installation-dir 1 1) + (Cyc-compilation-environment 1 1) (Cyc-default-exception-handler 1 1) (Cyc-current-exception-handler 0 0) (cons 2 2) @@ -486,6 +488,7 @@ ((eq? p 'string-set!) "Cyc_string_set") ((eq? p 'substring) "Cyc_substring") ((eq? p 'Cyc-installation-dir) "Cyc_installation_dir") + ((eq? p 'Cyc-compilation-environment) "Cyc_compilation_environment") ((eq? p 'command-line-arguments) "Cyc_command_line_arguments") ((eq? p 'system) "Cyc_system") ((eq? p 'assq) "assq") @@ -584,6 +587,7 @@ string-set! substring Cyc-installation-dir + Cyc-compilation-environment command-line-arguments assq assv @@ -681,7 +685,10 @@ bytevector bytevector-u8-ref bytevector-u8-set! - make-vector list->vector Cyc-installation-dir)))) + make-vector + list->vector + Cyc-compilation-environment + Cyc-installation-dir)))) ;; Primitive functions that pass a continuation or thread data but have no other arguments (define (prim:cont/no-args? exp) diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index 84d83e18..62c8d2c6 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -470,6 +470,7 @@ system command-line-arguments Cyc-installation-dir + Cyc-compilation-environment Cyc-default-exception-handler Cyc-current-exception-handler cell-get diff --git a/scheme/eval.sld b/scheme/eval.sld index 0d56cfdb..4c20f299 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -182,6 +182,7 @@ (list 'apply apply) (list '%halt %halt) (list 'exit exit) + (list 'Cyc-compilation-environment Cyc-compilation-environment) (list 'Cyc-installation-dir Cyc-installation-dir) (list 'system system) (list 'command-line-arguments command-line-arguments)