From 3837e373f32713e65de3aa992942670877efeccf Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 15 Nov 2007 17:05:55 -0600 Subject: [PATCH 1/6] unix.process : new version of with-fork --- extra/unix/process/process.factor | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/extra/unix/process/process.factor b/extra/unix/process/process.factor index a927d35ef5..fac95eabaa 100644 --- a/extra/unix/process/process.factor +++ b/extra/unix/process/process.factor @@ -27,5 +27,4 @@ IN: unix.process ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: with-fork ( child parent -- pid ) fork [ zero? -rot if ] keep ; inline - +: with-fork ( child parent -- ) fork dup zero? -roll swap curry if ; inline \ No newline at end of file From 44a5e155ab91448ca441052a10d28a4b97bd6f20 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 15 Nov 2007 17:06:40 -0600 Subject: [PATCH 2/6] Update vocabs for new with-fork --- extra/io/launcher/launcher.factor | 0 extra/io/unix/launcher/launcher.factor | 4 ++-- 2 files changed, 2 insertions(+), 2 deletions(-) mode change 100755 => 100644 extra/io/launcher/launcher.factor diff --git a/extra/io/launcher/launcher.factor b/extra/io/launcher/launcher.factor old mode 100755 new mode 100644 diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index 4bdec01af5..0e7ec9ad16 100644 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -54,8 +54,8 @@ M: unix-io run-process* ( desc -- ) setup-stdio-pipe (spawn-process) ] [ - 2dup second close first close - ] with-fork >r first swap second r> ; + -rot 2dup second close first close + ] with-fork first swap second rot ; TUPLE: pipe-stream pid ; From 225692f14498202d5720ed5481ffec044e1557a9 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 15 Nov 2007 17:49:43 -0600 Subject: [PATCH 3/6] Add wait-for-pid to unix.process (till we have something better) --- extra/unix/process/process.factor | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/extra/unix/process/process.factor b/extra/unix/process/process.factor index fac95eabaa..7f06f903ac 100644 --- a/extra/unix/process/process.factor +++ b/extra/unix/process/process.factor @@ -27,4 +27,15 @@ IN: unix.process ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: with-fork ( child parent -- ) fork dup zero? -roll swap curry if ; inline \ No newline at end of file +: with-fork ( child parent -- ) fork dup zero? -roll swap curry if ; inline + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! This is kludgy. We need a better implementation. + +USE: threads + +: wait-for-pid ( pid -- ) + dup "int" WNOHANG waitpid + 0 = [ 100 sleep wait-for-pid ] [ drop ] if ; + From f1f628dc0a9060247949431a23e47244beb3a989 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 15 Nov 2007 17:50:03 -0600 Subject: [PATCH 4/6] Add the raptor vocabulary --- extra/raptor/config.factor | 140 +++++++++++++++++++++++++++++++++++++ extra/raptor/raptor.factor | 60 ++++++++++++++++ extra/raptor/readme-0.1.1 | 117 +++++++++++++++++++++++++++++++ 3 files changed, 317 insertions(+) create mode 100644 extra/raptor/config.factor create mode 100644 extra/raptor/raptor.factor create mode 100644 extra/raptor/readme-0.1.1 diff --git a/extra/raptor/config.factor b/extra/raptor/config.factor new file mode 100644 index 0000000000..09e3bf2c60 --- /dev/null +++ b/extra/raptor/config.factor @@ -0,0 +1,140 @@ + +USING: namespaces unix.linux.if unix.linux.ifreq unix.linux.route ; + +IN: raptor + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: configure-lo ( -- ) + "lo" "127.0.0.1" set-if-addr + "lo" { IFF_UP } flags set-if-flags ; + +: configure-eth1 ( -- ) + "eth1" "192.168.1.10" set-if-addr + "eth1" { IFF_UP IFF_MULTICAST } flags set-if-flags ; + +: configure-route ( -- ) + "0.0.0.0" "192.168.1.1" "0.0.0.0" { RTF_UP RTF_GATEWAY } flags route ; + +[ + configure-lo + configure-eth1 + configure-route +] networking-hook set-global + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +[ + + ! rcS.d + + "mountvirtfs" start-service + "hostname.sh" start-service + "keymap.sh" start-service + "linux-restricted-modules-common" start-service + "udev" start-service + "mountdevsubfs" start-service + "module-init-tools" start-service + "procps.sh" start-service + "checkroot.sh" start-service + "mtab" start-service + "checkfs.sh" start-service + "mountall.sh" start-service + + start-networking + + "hwclock.sh" start-service + "displayconfig-hwprobe.py" start-service + "screen" start-service + "x11-common" start-service + "bootmisc.sh" start-service + "urandom" start-service + "console-screen.sh" start-service + + ! rc2.d + + "vbesave" start-service + "acpid" start-service + "powernowd.early" start-service + "sysklogd" start-service + "klogd" start-service + "dbus" start-service + "apmd" start-service + "hotkey-setup" start-service + "laptop-mode" start-service + "makedev" start-service + "nvidia-kernel" start-service + "postfix" start-service + "powernowd" start-service + "ntp-server" start-service + "anacron" start-service + "atd" start-service + "cron" start-service + "binfmt-support" start-service + "acpi-support" start-service + "rc.local" start-service + "rmnologin" start-service + + start-listeners + start-gettys +] boot-hook set-global + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +[ + "anacron" stop-service + "atd" stop-service + "cron" stop-service + "acpi-support" stop-service + "apmd" stop-service + "dbus" stop-service + "hotkey-setup" stop-service + "laptop-mode" stop-service + "makedev" stop-service + "nvidia-kernel" stop-service + "powernowd" stop-service + "acpid" stop-service + "hwclock.sh" stop-service + "alsa-utils" stop-service + "klogd" stop-service + "binfmt-support" stop-service + "sysklogd" stop-service + "linux-restricted-modules-common" stop-service + "sendsigs" stop-service + "urandom" stop-service + "umountnfs.sh" stop-service + "networking" stop-service + "umountfs" stop-service + "umountroot" stop-service + "reboot" stop-service +] reboot-hook set-global + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +[ + "anacron" stop-service + "atd" stop-service + "cron" stop-service + "acpi-support" stop-service + "apmd" stop-service + "dbus" stop-service + "hotkey-setup" stop-service + "laptop-mode" stop-service + "makedev" stop-service + "nvidia-kernel" stop-service + "postfix" stop-service + "powernowd" stop-service + "acpid" stop-service + "hwclock.sh" stop-service + "alsa-utils" stop-service + "klogd" stop-service + "binfmt-support" stop-service + "sysklogd" stop-service + "linux-restricted-modules-common" stop-service + "sendsigs" stop-service + "urandom" stop-service + "umountnfs.sh" stop-service + "umountfs" stop-service + "umountroot" stop-service + "halt" stop-service +] shutdown-hook set-global \ No newline at end of file diff --git a/extra/raptor/raptor.factor b/extra/raptor/raptor.factor new file mode 100644 index 0000000000..038477a3cd --- /dev/null +++ b/extra/raptor/raptor.factor @@ -0,0 +1,60 @@ + +USING: kernel parser namespaces threads unix.process combinators.cleave ; + +IN: raptor + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +SYMBOL: boot-hook +SYMBOL: reboot-hook +SYMBOL: shutdown-hook +SYMBOL: networking-hook + +: reload-raptor-config ( -- ) "/etc/raptor/config.factor" run-file ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +USING: sequences unix ; + +: start-service ( name -- ) "/etc/init.d/" swap " start" 3append system drop ; +: stop-service ( name -- ) "/etc/init.d/" swap " stop" 3append system drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: fork-exec-wait ( pathname args -- ) + fork dup 0 = [ drop exec drop ] [ 2nip wait-for-pid ] if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: respawn ( pathname args -- ) [ fork-exec-wait ] [ respawn ] 2bi ; + +: start-gettys ( -- ) + [ "/sbin/getty" { "getty" "38400" "tty5" } respawn ] in-thread + [ "/sbin/getty" { "getty" "38400" "tty6" } respawn ] in-thread ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +USING: io io.files io.streams.lines io.streams.plain io.streams.duplex + listener ; + +: tty-listener ( tty -- ) + [ ] + [ ] + bi [ listener ] with-stream ; + +: forever ( quot -- ) [ call ] [ forever ] bi ; + +: start-listeners ( -- ) + [ [ "/dev/tty2" tty-listener ] forever ] in-thread + [ [ "/dev/tty3" tty-listener ] forever ] in-thread + [ [ "/dev/tty4" tty-listener ] forever ] in-thread ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: start-networking ( -- ) networking-hook get call ; + +: boot ( -- ) boot-hook get call ; +: reboot ( -- ) reboot-hook get call ; +: shutdown ( -- ) shutdown-hook get call ; + +MAIN: boot diff --git a/extra/raptor/readme-0.1.1 b/extra/raptor/readme-0.1.1 new file mode 100644 index 0000000000..303fb416c4 --- /dev/null +++ b/extra/raptor/readme-0.1.1 @@ -0,0 +1,117 @@ + +Raptor Linux + +*** Introduction *** + +Raptor Linux is a mod of Ubuntu 6.06 (Dapper Drake) + +This is unlikely to work on another version of Ubuntu, much less +another Linux distribution. + +*** Install *** + + ( scratchpad ) USE: raptor + ( scratchpad ) save + + # mv -v /sbin/{init,init.orig} + + # cp -v /scratch/factor/factor /sbin/init + + # cp -v /scratch/factor/factor.image /sbin/init.image + + # mkdir -v /etc/raptor + + # cp -v /scratch/factor/extra/raptor/config.factor /etc/raptor/config.factor + +*** Static IP networking *** + +If you use a static IP in your network then Factor can take care of +networking. + + # emacs /etc/raptor/config.factor + + (change the settings accordingly) + +The udev system has a hook to bring up ethernet interfaces when they +are detected. Let's remove this hook since we'll be bringing up the +interface. Actually, we'll move it, not delete it. + + # mv -v /etc/udev/rules.d/85-ifupdown.rules /root + +*** DHCP networking *** + +If you're using dhcp then we'll fall back on what Ubuntu offers. In +your config.factor change the line : + + start-networking + +to + + "loopback" start-service + "networking" start-service + +Add these to your reboot-hook and shutdown-hook : + + "loopback" stop-service + "networking" stop-service + +*** Editing the hooks *** + +The items in boot-hook correspond to the things in '/etc/rcS.d' and +'/etc/rc2.d'. Feel free to add and remove items from that hook. For +example, I removed the printer services. I also removed other things +that I didn't feel were necessary on my system. + +*** Grub *** + +Edit your '/boot/grub/menu.lst'. Basically, copy and paste your +current good entry. My default entry is this: + +title Ubuntu, kernel 2.6.15-28-686 +root (hd0,0) +kernel /boot/vmlinuz-2.6.15-28-686 root=/dev/hda1 ro quiet splash +initrd /boot/initrd.img-2.6.15-28-686 +savedefault +boot + +I pasted a copy above it and edited it to look like this: + +title Raptor, kernel 2.6.15-28-686 +root (hd0,0) +kernel /boot/vmlinuz-2.6.15-28-686 root=/dev/hda1 ro quiet -run=ubuntu.dapper.boot +initrd /boot/initrd.img-2.6.15-28-686 +savedefault +boot + +* Note that I removed the 'splash' kernel option + +* Note the '-run=ubuntu.dapper.boot' option. Unfortunately, this isn't + working yet... + +*** Boot *** + +Reboot or turn on your computer. Eventually, hopefully, you'll be at a +Factor prompt. Boot your system: + + ( scratchpad ) boot + +You'll probably be prompted to select a vocab. Select 'raptor'. + +*** Now what *** + +The virtual consoles are allocated like so: + + 1 - Main listener console + 2 - listener + 3 - listener + 4 - listener + 5 - getty + 6 - getty + +So you're next step might be to alt-f5, login, and run startx. + +*** Join the fun *** + +Take a loot at what happens during run levels S and 2. Implement a +Factor version of something. Let me know about it. + From f24abc72d15551e550ceb0adc1ca69392966c923 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 15 Nov 2007 20:47:51 -0600 Subject: [PATCH 5/6] The beginnings of a cron for raptor --- extra/raptor/config.factor | 18 +++++-------- extra/raptor/cron/cron.factor | 48 +++++++++++++++++++++++++++++++++++ extra/raptor/cronjobs.factor | 47 ++++++++++++++++++++++++++++++++++ extra/raptor/raptor.factor | 4 ++- 4 files changed, 105 insertions(+), 12 deletions(-) create mode 100644 extra/raptor/cron/cron.factor create mode 100644 extra/raptor/cronjobs.factor diff --git a/extra/raptor/config.factor b/extra/raptor/config.factor index 09e3bf2c60..d06d8e3db0 100644 --- a/extra/raptor/config.factor +++ b/extra/raptor/config.factor @@ -3,6 +3,8 @@ USING: namespaces unix.linux.if unix.linux.ifreq unix.linux.route ; IN: raptor +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Networking ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : configure-lo ( -- ) @@ -41,7 +43,9 @@ IN: raptor "checkfs.sh" start-service "mountall.sh" start-service - start-networking + start-networking +! "loopback" start-service +! "networking" start-service "hwclock.sh" start-service "displayconfig-hwprobe.py" start-service @@ -49,7 +53,6 @@ IN: raptor "x11-common" start-service "bootmisc.sh" start-service "urandom" start-service - "console-screen.sh" start-service ! rc2.d @@ -67,24 +70,20 @@ IN: raptor "postfix" start-service "powernowd" start-service "ntp-server" start-service - "anacron" start-service - "atd" start-service - "cron" start-service "binfmt-support" start-service "acpi-support" start-service "rc.local" start-service "rmnologin" start-service + schedule-cron-jobs start-listeners start-gettys + ] boot-hook set-global ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! [ - "anacron" stop-service - "atd" stop-service - "cron" stop-service "acpi-support" stop-service "apmd" stop-service "dbus" stop-service @@ -112,9 +111,6 @@ IN: raptor ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! [ - "anacron" stop-service - "atd" stop-service - "cron" stop-service "acpi-support" stop-service "apmd" stop-service "dbus" stop-service diff --git a/extra/raptor/cron/cron.factor b/extra/raptor/cron/cron.factor new file mode 100644 index 0000000000..f004ba30d5 --- /dev/null +++ b/extra/raptor/cron/cron.factor @@ -0,0 +1,48 @@ + +USING: kernel threads sequences calendar combinators.cleave combinators.lib ; + +IN: raptor.cron + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: when minute hour day-of-month month day-of-week ; + +C: when + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: slot-match? ( now-slot when-slot -- ? ) dup f = [ 2drop t ] [ member? ] if ; + +: minute-match? ( now when -- ? ) + [ timestamp-minute ] [ when-minute ] bi* slot-match? ; + +: hour-match? ( now when -- ? ) + [ timestamp-hour ] [ when-hour ] bi* slot-match? ; + +: day-of-month-match? ( now when -- ? ) + [ timestamp-day ] [ when-day-of-month ] bi* slot-match? ; + +: month-match? ( now when -- ? ) + [ timestamp-month ] [ when-month ] bi* slot-match? ; + +: day-of-week-match? ( now when -- ? ) + [ day-of-week ] [ when-day-of-week ] bi* slot-match? ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: when=now? ( when -- ? ) + now swap + { [ minute-match? ] + [ hour-match? ] + [ day-of-month-match? ] + [ month-match? ] + [ day-of-week-match? ] } + <--&& ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: recurring-job ( when quot -- ) + [ swap when=now? [ call ] [ drop ] if 60000 sleep ] [ recurring-job ] 2bi ; + +: schedule ( when quot -- ) [ recurring-job ] curry curry in-thread ; + diff --git a/extra/raptor/cronjobs.factor b/extra/raptor/cronjobs.factor new file mode 100644 index 0000000000..394c213162 --- /dev/null +++ b/extra/raptor/cronjobs.factor @@ -0,0 +1,47 @@ + +USING: kernel threads arrays sequences combinators.cleave raptor raptor.cron ; + +IN: raptor + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: fork-exec-args-wait ( args -- ) [ first ] [ ] bi fork-exec-wait ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: cron-hourly ( -- ) ; + +: cron-daily ( -- ) + { "/etc/cron.daily/apt" + "/etc/cron.daily/aptitude" + "/etc/cron.daily/bsdmainutils" + "/etc/cron.daily/find.notslocate" + "/etc/cron.daily/logrotate" + "/etc/cron.daily/man-db" + "/etc/cron.daily/ntp-server" + "/etc/cron.daily/slocate" + "/etc/cron.daily/standard" + "/etc/cron.daily/sysklogd" + "/etc/cron.daily/tetex-bin" } + [ 1array [ fork-exec-args-wait ] in-thread drop ] each ; + +: cron-weekly ( -- ) + { "/etc/cron.weekly/cvs" + "/etc/cron.weekly/man-db" + "/etc/cron.weekly/ntp-server" + "/etc/cron.weekly/popularity-contest" + "/etc/cron.weekly/sysklogd" } + [ 1array [ fork-exec-args-wait ] in-thread drop ] each ; + +: cron-monthly ( -- ) + { "/etc/cron.monthly/scrollkeeper" + "/etc/cron.monthly/standard" } + [ 1array [ fork-exec-args-wait ] in-thread drop ] each ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: schedule-cron-jobs ( -- ) + { 17 } f f f f [ cron-hourly ] schedule + { 25 } { 6 } f f f [ cron-daily ] schedule + { 47 } { 6 } f f { 7 } [ cron-weekly ] schedule + { 52 } { 6 } { 1 } f f [ cron-monthly ] schedule ; \ No newline at end of file diff --git a/extra/raptor/raptor.factor b/extra/raptor/raptor.factor index 038477a3cd..b0b9c05895 100644 --- a/extra/raptor/raptor.factor +++ b/extra/raptor/raptor.factor @@ -10,7 +10,9 @@ SYMBOL: reboot-hook SYMBOL: shutdown-hook SYMBOL: networking-hook -: reload-raptor-config ( -- ) "/etc/raptor/config.factor" run-file ; +: reload-raptor-config ( -- ) + "/etc/raptor/config.factor" run-file + "/etc/raptor/cronjobs.factor" run-file ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From 1bc4a852e1a41f2e45dd560e2402ad89888e930b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 16 Nov 2007 00:10:34 -0500 Subject: [PATCH 6/6] Remove run.s --- vm/run.s | 1117 ------------------------------------------------------ 1 file changed, 1117 deletions(-) delete mode 100644 vm/run.s diff --git a/vm/run.s b/vm/run.s deleted file mode 100644 index 8700b6cce8..0000000000 --- a/vm/run.s +++ /dev/null @@ -1,1117 +0,0 @@ - .file "run.c" - .text - .align 0 - .global reset_datastack - .def reset_datastack; .scl 2; .type 32; .endef -reset_datastack: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - @ link register save eliminated. - ldr r3, .L3 - @ lr needed for prologue - ldr r2, [r3, #0] - ldr r1, [r2, #24] - ldr r3, [r1, #0] - sub r5, r3, #4 - mov pc, lr -.L4: - .align 0 -.L3: - .word stack_chain - .align 0 - .global reset_retainstack - .def reset_retainstack; .scl 2; .type 32; .endef -reset_retainstack: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - @ link register save eliminated. - ldr r3, .L7 - @ lr needed for prologue - ldr r2, [r3, #0] - ldr r1, [r2, #28] - ldr r3, [r1, #0] - sub r6, r3, #4 - mov pc, lr -.L8: - .align 0 -.L7: - .word stack_chain - .align 0 - .global save_stacks - .def save_stacks; .scl 2; .type 32; .endef -save_stacks: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - @ link register save eliminated. - ldr r3, .L11 - @ lr needed for prologue - ldr r2, [r3, #0] - str r6, [r2, #12] - str r5, [r2, #8] - mov pc, lr -.L12: - .align 0 -.L11: - .word stack_chain - .align 0 - .global init_stacks - .def init_stacks; .scl 2; .type 32; .endef -init_stacks: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - @ link register save eliminated. - ldr r3, .L15 - ldr r2, .L15+4 - str r0, [r3, #0] - ldr r3, .L15+8 - str r1, [r2, #0] - mov r1, #0 - @ lr needed for prologue - str r1, [r3, #0] - mov pc, lr -.L16: - .align 0 -.L15: - .word ds_size - .word rs_size - .word stack_chain - .align 0 - .global enable_word_profiling - .def enable_word_profiling; .scl 2; .type 32; .endef -enable_word_profiling: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - @ link register save eliminated. - ldr r3, .L21 - ldr r2, [r0, #32] - @ lr needed for prologue - cmp r2, r3 - ldreq r3, .L21+4 - streq r3, [r0, #32] - mov pc, lr -.L22: - .align 0 -.L21: - .word docol - .word docol_profiling - .align 0 - .global disable_word_profiling - .def disable_word_profiling; .scl 2; .type 32; .endef -disable_word_profiling: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - @ link register save eliminated. - ldr r3, .L27 - ldr r2, [r0, #32] - @ lr needed for prologue - cmp r2, r3 - ldreq r3, .L27+4 - streq r3, [r0, #32] - mov pc, lr -.L28: - .align 0 -.L27: - .word docol_profiling - .word docol - .align 0 - .global primitive_3drop - .def primitive_3drop; .scl 2; .type 32; .endef -primitive_3drop: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - str lr, [sp, #-4]! - mov r0, r1 - bl save_callstack_top - sub r5, r5, #12 - ldr pc, [sp], #4 - .align 0 - .global primitive_2drop - .def primitive_2drop; .scl 2; .type 32; .endef -primitive_2drop: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - str lr, [sp, #-4]! - mov r0, r1 - bl save_callstack_top - sub r5, r5, #8 - ldr pc, [sp], #4 - .align 0 - .global primitive_millis - .def primitive_millis; .scl 2; .type 32; .endef -primitive_millis: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - str lr, [sp, #-4]! - mov r0, r1 - bl save_callstack_top - bl current_millis - ldr lr, [sp], #4 - b box_unsigned_8 - .align 0 - .global array_to_stack - .def array_to_stack; .scl 2; .type 32; .endef -array_to_stack: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - stmfd sp!, {r4, r7, lr} - ldr r4, [r0, #4] - mov r7, r1 - mov r4, r4, lsr #3 - mov r4, r4, asl #2 - add r1, r0, #8 - mov r2, r4 - mov r0, r7 - bl memcpy - add r4, r4, r7 - sub r0, r4, #4 - ldmfd sp!, {r4, r7, pc} - .align 0 - .global unnest_stacks - .def unnest_stacks; .scl 2; .type 32; .endef -unnest_stacks: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - stmfd sp!, {r4, lr} - ldr r4, .L39 - ldr r3, [r4, #0] - ldr r0, [r3, #24] - bl dealloc_segment - ldr r3, [r4, #0] - ldr r0, [r3, #28] - bl dealloc_segment - ldr r0, [r4, #0] - ldr r1, .L39+4 - ldr r2, [r0, #36] - ldr r5, [r0, #16] - ldr r6, [r0, #20] - str r2, [r1, #8] - ldr r3, [r0, #32] - str r3, [r1, #4] - ldr r2, [r0, #40] - ldr r1, [r0, #44] - ldr r3, .L39+8 - str r1, [r4, #0] - str r2, [r3, #0] - ldmfd sp!, {r4, lr} - b free -.L40: - .align 0 -.L39: - .word stack_chain - .word userenv - .word extra_roots - .align 0 - .global primitive_drop - .def primitive_drop; .scl 2; .type 32; .endef -primitive_drop: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - str lr, [sp, #-4]! - mov r0, r1 - bl save_callstack_top - sub r5, r5, #4 - ldr pc, [sp], #4 - .align 0 - .global primitive_swapd - .def primitive_swapd; .scl 2; .type 32; .endef -primitive_swapd: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - mov r0, r1 - str lr, [sp, #-4]! - bl save_callstack_top - ldr r1, [r5, #-4] - ldr r2, [r5, #-8] - stmdb r5, {r1, r2} @ phole stm - ldr pc, [sp], #4 - .align 0 - .global primitive_swap - .def primitive_swap; .scl 2; .type 32; .endef -primitive_swap: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - mov r0, r1 - str lr, [sp, #-4]! - bl save_callstack_top - ldr r1, [r5, #0] - ldr r2, [r5, #-4] - stmda r5, {r1, r2} @ phole stm - ldr pc, [sp], #4 - .align 0 - .global primitive__rot - .def primitive__rot; .scl 2; .type 32; .endef -primitive__rot: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - mov r0, r1 - str lr, [sp, #-4]! - bl save_callstack_top - ldr r0, [r5, #0] - ldmdb r5, {r1, r2} @ phole ldm - stmda r5, {r0, r1, r2} @ phole stm - ldr pc, [sp], #4 - .align 0 - .global primitive_rot - .def primitive_rot; .scl 2; .type 32; .endef -primitive_rot: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - mov r0, r1 - str lr, [sp, #-4]! - bl save_callstack_top - ldr r0, [r5, #0] - ldr r2, [r5, #-8] - ldr r1, [r5, #-4] - stmda r5, {r0, r2} @ phole stm - str r1, [r5, #-8] - ldr pc, [sp], #4 - .align 0 - .global primitive_3dup - .def primitive_3dup; .scl 2; .type 32; .endef -primitive_3dup: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - mov r0, r1 - str lr, [sp, #-4]! - bl save_callstack_top - ldmda r5, {r0, r1, r2} @ phole ldm - mov r3, r5 - add r5, r5, #12 - str r2, [r3, #12] - stmdb r5, {r0, r1} @ phole stm - ldr pc, [sp], #4 - .align 0 - .global primitive_2dup - .def primitive_2dup; .scl 2; .type 32; .endef -primitive_2dup: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - mov r0, r1 - str lr, [sp, #-4]! - bl save_callstack_top - ldr r0, [r5, #0] - ldr r2, [r5, #-4] - add r1, r5, #8 - mov r5, r1 - str r2, [r5, #-4] - str r0, [r5, #0] - ldr pc, [sp], #4 - .align 0 - .global primitive_sleep - .def primitive_sleep; .scl 2; .type 32; .endef -primitive_sleep: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - mov r0, r1 - str lr, [sp, #-4]! - bl save_callstack_top - mov r3, r5 - ldr r0, [r3], #-4 - mov r5, r3 - bl to_cell - ldr lr, [sp], #4 - b sleep_millis - .align 0 - .global primitive_exit - .def primitive_exit; .scl 2; .type 32; .endef -primitive_exit: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - mov r0, r1 - str lr, [sp, #-4]! - bl save_callstack_top - mov r3, r5 - ldr r0, [r3], #-4 - mov r5, r3 - bl to_fixnum - bl exit - .align 0 - .global primitive_to_r - .def primitive_to_r; .scl 2; .type 32; .endef -primitive_to_r: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - mov r0, r1 - str lr, [sp, #-4]! - bl save_callstack_top - mov r3, r5 - ldr r1, [r3], #-4 - add r2, r6, #4 - mov r6, r2 - mov r5, r3 - str r1, [r6, #0] - ldr pc, [sp], #4 - .align 0 - .global primitive_eq - .def primitive_eq; .scl 2; .type 32; .endef -primitive_eq: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - mov r0, r1 - str lr, [sp, #-4]! - bl save_callstack_top - mov r0, r5 - ldr r1, [r5, #-4] - ldr r2, [r0], #-4 - mov r3, #7 - cmp r2, r1 - ldreq r3, .L66 - mov r5, r0 - ldreq r3, [r3, #0] - str r3, [r0, #0] - ldr pc, [sp], #4 -.L67: - .align 0 -.L66: - .word T - .align 0 - .global primitive_getenv - .def primitive_getenv; .scl 2; .type 32; .endef -primitive_getenv: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - mov r0, r1 - str lr, [sp, #-4]! - bl save_callstack_top - ldr r3, [r5, #0] - ldr r2, .L70 - mov r3, r3, asr #3 - ldr r1, [r2, r3, asl #2] - str r1, [r5, #0] - ldr pc, [sp], #4 -.L71: - .align 0 -.L70: - .word userenv - .align 0 - .global primitive_2nip - .def primitive_2nip; .scl 2; .type 32; .endef -primitive_2nip: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - str lr, [sp, #-4]! - mov r0, r1 - bl save_callstack_top - ldr r2, [r5, #0] - mov r3, r5 - sub r5, r5, #8 - str r2, [r3, #-8] - ldr pc, [sp], #4 - .align 0 - .global primitive_nip - .def primitive_nip; .scl 2; .type 32; .endef -primitive_nip: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - mov r0, r1 - str lr, [sp, #-4]! - bl save_callstack_top - mov r2, r5 - ldr r1, [r2], #-4 - str r1, [r5, #-4] - mov r5, r2 - ldr pc, [sp], #4 - .align 0 - .global primitive_os_env - .def primitive_os_env; .scl 2; .type 32; .endef -primitive_os_env: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - str lr, [sp, #-4]! - mov r0, r1 - bl save_callstack_top - bl unbox_char_string - bl getenv - add r3, r5, #4 - cmp r0, #0 - moveq r5, r3 - moveq r3, #7 - streq r3, [r5, #0] - ldreq pc, [sp], #4 - ldr lr, [sp], #4 - b box_char_string - .align 0 - .global stack_to_array - .def stack_to_array; .scl 2; .type 32; .endef -stack_to_array: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - stmfd sp!, {r4, r7, r8, lr} - mov r8, r0 - rsb r1, r8, r1 - adds r7, r1, #4 - mov r0, #8 - mov r1, r7, asr #2 - mov r3, #0 - bmi .L85 - bl allot_array_internal - mov r1, r8 - mov r4, r0 - mov r2, r7 - add r0, r0, #8 - bl memcpy - bic r4, r4, #7 - add r3, r5, #4 - mov r5, r3 - orr r4, r4, #3 - str r4, [r5, #0] - mov r3, #1 -.L85: - mov r0, r3 - ldmfd sp!, {r4, r7, r8, pc} - .align 0 - .global primitive_from_r - .def primitive_from_r; .scl 2; .type 32; .endef -primitive_from_r: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - mov r0, r1 - str lr, [sp, #-4]! - bl save_callstack_top - mov r3, r6 - ldr r1, [r3], #-4 - add r2, r5, #4 - mov r5, r2 - mov r6, r3 - str r1, [r5, #0] - ldr pc, [sp], #4 - .align 0 - .global primitive_pick - .def primitive_pick; .scl 2; .type 32; .endef -primitive_pick: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - str lr, [sp, #-4]! - mov r0, r1 - bl save_callstack_top - ldr r2, [r5, #-8] - mov r3, r5 - add r5, r5, #4 - str r2, [r3, #4] - ldr pc, [sp], #4 - .align 0 - .global primitive_over - .def primitive_over; .scl 2; .type 32; .endef -primitive_over: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - str lr, [sp, #-4]! - mov r0, r1 - bl save_callstack_top - ldr r2, [r5, #-4] - mov r3, r5 - add r5, r5, #4 - str r2, [r3, #4] - ldr pc, [sp], #4 - .align 0 - .global primitive_tuck - .def primitive_tuck; .scl 2; .type 32; .endef -primitive_tuck: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - mov r0, r1 - str lr, [sp, #-4]! - bl save_callstack_top - ldr r0, [r5, #0] - ldr r2, [r5, #-4] - add r1, r5, #4 - mov r3, r5 - mov r5, r1 - stmda r3, {r0, r2} @ phole stm - str r0, [r5, #0] - ldr pc, [sp], #4 - .align 0 - .global primitive_dupd - .def primitive_dupd; .scl 2; .type 32; .endef -primitive_dupd: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - mov r0, r1 - str lr, [sp, #-4]! - bl save_callstack_top - ldr r0, [r5, #0] - ldr r2, [r5, #-4] - add r1, r5, #4 - mov r3, r5 - mov r5, r1 - str r2, [r3, #0] - str r0, [r5, #0] - ldr pc, [sp], #4 - .align 0 - .global primitive_dup - .def primitive_dup; .scl 2; .type 32; .endef -primitive_dup: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - mov r0, r1 - str lr, [sp, #-4]! - bl save_callstack_top - mov r2, r5 - ldr r1, [r2], #4 - str r1, [r5, #4] - mov r5, r2 - ldr pc, [sp], #4 - .align 0 - .global primitive_set_slot - .def primitive_set_slot; .scl 2; .type 32; .endef -primitive_set_slot: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - mov r0, r1 - str lr, [sp, #-4]! - bl save_callstack_top - mov r0, r5 - ldr r1, [r0], #-4 - ldr ip, [r5, #-4] - ldr lr, [r0, #-4] - mov r1, r1, asr #3 - bic r3, ip, #7 - ldr r2, .L101 - str lr, [r3, r1, asl #2] - ldr r1, [r2, #0] - sub lr, r0, #4 - ldrb r3, [r1, ip, lsr #6] @ zero_extendqisi2 - mov r5, r0 - mvn r3, r3, asl #26 - mvn r3, r3, lsr #26 - mov r5, lr - sub r5, lr, #4 - strb r3, [r1, ip, lsr #6] - ldr pc, [sp], #4 -.L102: - .align 0 -.L101: - .word cards_offset - .align 0 - .global primitive_slot - .def primitive_slot; .scl 2; .type 32; .endef -primitive_slot: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - mov r0, r1 - str lr, [sp, #-4]! - bl save_callstack_top - mov r1, r5 - ldr r2, [r1], #-4 - ldr r3, [r5, #-4] - mov r2, r2, asr #3 - bic r3, r3, #7 - ldr ip, [r3, r2, asl #2] - mov r0, r5 - mov r5, r1 - sub r5, r1, #4 - mov r5, r1 - str ip, [r0, #-4] - ldr pc, [sp], #4 - .align 0 - .global primitive_setenv - .def primitive_setenv; .scl 2; .type 32; .endef -primitive_setenv: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - mov r0, r1 - str lr, [sp, #-4]! - bl save_callstack_top - mov r1, r5 - ldr r3, [r1], #-4 - ldr r0, [r5, #-4] - ldr r2, .L107 - mov r3, r3, asr #3 - mov r5, r1 - sub r5, r1, #4 - str r0, [r2, r3, asl #2] - ldr pc, [sp], #4 -.L108: - .align 0 -.L107: - .word userenv - .align 0 - .global primitive_class_hash - .def primitive_class_hash; .scl 2; .type 32; .endef -primitive_class_hash: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - mov r0, r1 - str lr, [sp, #-4]! - bl save_callstack_top - ldr r3, [r5, #0] - and r2, r3, #7 - cmp r2, #2 - bic r0, r3, #7 - beq .L116 - cmp r2, #3 - bic r3, r3, #7 - ldreq r3, [r3, #0] - mov r0, r2, asl #3 - streq r3, [r5, #0] - strne r0, [r5, #0] - ldr pc, [sp], #4 -.L116: - ldr r3, [r0, #8] - bic r3, r3, #7 - ldr r2, [r3, #4] - str r2, [r5, #0] - ldr pc, [sp], #4 - .align 0 - .global primitive_tag - .def primitive_tag; .scl 2; .type 32; .endef -primitive_tag: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - str lr, [sp, #-4]! - mov r0, r1 - bl save_callstack_top - ldr r3, [r5, #0] - and r3, r3, #7 - mov r3, r3, asl #3 - str r3, [r5, #0] - ldr pc, [sp], #4 - .align 0 - .global nest_stacks - .def nest_stacks; .scl 2; .type 32; .endef -nest_stacks: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - stmfd sp!, {r4, lr} - mov r0, #48 - bl safe_malloc - mov r4, r0 - ldr r0, .L121 - str r5, [r4, #16] - str r6, [r4, #20] - ldr r3, [r0, #8] - mvn r2, #0 - str r3, [r4, #36] - ldr r1, [r0, #4] - ldr r3, .L121+4 - str r1, [r4, #32] - str r2, [r4, #0] - str r2, [r4, #4] - ldr r0, [r3, #0] - bl alloc_segment - ldr r3, .L121+8 - str r0, [r4, #24] - ldr r0, [r3, #0] - bl alloc_segment - ldr r3, .L121+12 - ldr ip, [r4, #24] - ldr r2, [r3, #0] - ldr r1, .L121+16 - str r2, [r4, #40] - ldr lr, [ip, #0] - ldr r2, [r0, #0] - ldr r3, [r1, #0] - sub r5, lr, #4 - sub r6, r2, #4 - str r3, [r4, #44] - str r0, [r4, #28] - str r4, [r1, #0] - ldmfd sp!, {r4, pc} -.L122: - .align 0 -.L121: - .word userenv - .word ds_size - .word rs_size - .word extra_roots - .word stack_chain - .align 0 - .global fix_stacks - .def fix_stacks; .scl 2; .type 32; .endef -fix_stacks: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - ldr r2, .L131 - add r3, r5, #4 - ldr r2, [r2, #0] - stmfd sp!, {r4, lr} - ldr r0, [r2, #24] - add r4, r6, #256 - ldr ip, [r0, #0] - add lr, r5, #256 - cmp r3, ip - add r1, r6, #4 - bcc .L124 - ldr r3, [r0, #8] - cmp lr, r3 - bcs .L124 -.L126: - ldr r2, [r2, #28] - ldr r0, [r2, #0] - cmp r1, r0 - bcc .L127 - ldr r3, [r2, #8] - cmp r4, r3 - ldmccfd sp!, {r4, pc} -.L127: - sub r6, r0, #4 - ldmfd sp!, {r4, pc} -.L124: - sub r5, ip, #4 - b .L126 -.L132: - .align 0 -.L131: - .word stack_chain - .align 0 - .global primitive_type - .def primitive_type; .scl 2; .type 32; .endef -primitive_type: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - mov r0, r1 - str lr, [sp, #-4]! - bl save_callstack_top - ldr r3, [r5, #0] - bic r1, r3, #7 - and r3, r3, #7 - cmp r3, #3 - ldreq r3, [r1, #0] - moveq r3, r3, lsr #3 - mov r3, r3, asl #3 - str r3, [r5, #0] - ldr pc, [sp], #4 - .align 0 - .global default_word_xt - .def default_word_xt; .scl 2; .type 32; .endef -default_word_xt: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - ldr r3, .L154 - ldr r0, [r0, #16] - ldr r2, [r3, #0] - str lr, [sp, #-4]! - cmp r0, r2 - ldreq r0, .L154+4 - ldreq pc, [sp], #4 - and r1, r0, #7 - cmp r1, #3 - biceq r3, r0, #7 - ldreq r2, [r3, #0] - movne r2, r1 - moveq r2, r2, lsr #3 - cmp r2, #14 - beq .L153 - cmp r1, #3 - biceq r3, r0, #7 - ldreq r2, [r3, #0] - moveq r1, r2, lsr #3 - cmp r1, #0 - ldrne r0, .L154+8 - ldrne pc, [sp], #4 - bl to_fixnum - ldr r3, .L154+12 - ldr r0, [r3, r0, asl #2] - ldr pc, [sp], #4 -.L153: - ldr r3, .L154+16 - ldr r2, .L154+20 - ldrb r1, [r3, #0] @ zero_extendqisi2 - ldr r3, .L154+24 - cmp r1, #0 - moveq r0, r2 - movne r0, r3 - ldr pc, [sp], #4 -.L155: - .align 0 -.L154: - .word T - .word dosym - .word undefined - .word primitives - .word profiling - .word docol - .word docol_profiling - .align 0 - .global primitive_profiling - .def primitive_profiling; .scl 2; .type 32; .endef -primitive_profiling: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - stmfd sp!, {r4, r7, r8, lr} - mov r0, r1 - bl save_callstack_top - mov r3, r5 - ldr r0, [r3], #-4 - ldr r4, .L175 - mov r5, r3 - bl to_boolean - strb r0, [r4, #0] - bl begin_scan - ldr r8, .L175+4 - ldr r7, .L175+8 -.L173: - bl next_object - cmp r0, #7 - bic r2, r0, #7 - and r3, r0, #7 - beq .L174 -.L158: - cmp r3, #3 - ldreq r3, [r2, #0] - moveq r3, r3, lsr #3 - cmp r3, #17 - bne .L173 - ldrb r3, [r4, #0] @ zero_extendqisi2 - bic r2, r0, #7 - cmp r3, #0 - bic r0, r0, #7 - beq .L162 - ldr r3, [r2, #32] - cmp r3, r8 - streq r7, [r2, #32] - bl next_object - cmp r0, #7 - bic r2, r0, #7 - and r3, r0, #7 - bne .L158 -.L174: - ldr r3, .L175+12 - mov r2, #0 - strb r2, [r3, #0] - ldmfd sp!, {r4, r7, r8, pc} -.L162: - ldr r3, [r0, #32] - cmp r3, r7 - streq r8, [r0, #32] - b .L173 -.L176: - .align 0 -.L175: - .word profiling - .word docol - .word docol_profiling - .word gc_off - .align 0 - .global primitive_set_retainstack - .def primitive_set_retainstack; .scl 2; .type 32; .endef -primitive_set_retainstack: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - mov r0, r1 - stmfd sp!, {r4, r7, lr} - bl save_callstack_top - mov r3, r5 - ldr r1, [r3], #-4 - mov r0, #8 - and r2, r1, #7 - cmp r2, #3 - bic r4, r1, #7 - mov r5, r3 - ldreq r3, [r4, #0] - moveq r2, r3, lsr #3 - cmp r2, #8 - blne type_error -.L181: - ldr r3, .L184 - ldr r7, [r4, #4] - ldr r2, [r3, #0] - add r1, r4, #8 - ldr r0, [r2, #28] - mov r7, r7, lsr #3 - ldr r4, [r0, #0] - mov r7, r7, asl #2 - mov r0, r4 - mov r2, r7 - bl memcpy - add r4, r4, r7 - sub r6, r4, #4 - ldmfd sp!, {r4, r7, pc} -.L185: - .align 0 -.L184: - .word stack_chain - .align 0 - .global primitive_set_datastack - .def primitive_set_datastack; .scl 2; .type 32; .endef -primitive_set_datastack: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - mov r0, r1 - stmfd sp!, {r4, r7, lr} - bl save_callstack_top - mov r3, r5 - ldr r1, [r3], #-4 - mov r0, #8 - and r2, r1, #7 - cmp r2, #3 - bic r4, r1, #7 - mov r5, r3 - ldreq r3, [r4, #0] - moveq r2, r3, lsr #3 - cmp r2, #8 - blne type_error -.L190: - ldr r3, .L193 - ldr r7, [r4, #4] - ldr r2, [r3, #0] - add r1, r4, #8 - ldr r0, [r2, #24] - mov r7, r7, lsr #3 - ldr r4, [r0, #0] - mov r7, r7, asl #2 - mov r0, r4 - mov r2, r7 - bl memcpy - add r4, r4, r7 - sub r5, r4, #4 - ldmfd sp!, {r4, r7, pc} -.L194: - .align 0 -.L193: - .word stack_chain - .align 0 - .global primitive_retainstack - .def primitive_retainstack; .scl 2; .type 32; .endef -primitive_retainstack: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - stmfd sp!, {r4, r7, r8, lr} - mov r0, r1 - bl save_callstack_top - ldr ip, .L200 - mov r1, #7 - ldr lr, [ip, #0] - mov r0, #8 - ldr r4, [lr, #28] - mov r2, r1 - ldr r8, [r4, #0] - mov r3, #0 - rsb ip, r8, r6 - adds r7, ip, #4 - bmi .L196 - mov r1, r7, asr #2 - bl allot_array_internal - mov r1, r8 - mov r4, r0 - mov r2, r7 - add r0, r0, #8 - bl memcpy - bic r4, r4, #7 - add r3, r5, #4 - mov r5, r3 - orr r4, r4, #3 - str r4, [r5, #0] - ldmfd sp!, {r4, r7, r8, pc} -.L196: - mov r0, #13 - ldmfd sp!, {r4, r7, r8, lr} - b general_error -.L201: - .align 0 -.L200: - .word stack_chain - .align 0 - .global primitive_datastack - .def primitive_datastack; .scl 2; .type 32; .endef -primitive_datastack: - @ args = 0, pretend = 0, frame = 0 - @ frame_needed = 0, uses_anonymous_args = 0 - stmfd sp!, {r4, r7, r8, lr} - mov r0, r1 - bl save_callstack_top - ldr ip, .L207 - mov r1, #7 - ldr lr, [ip, #0] - mov r0, #8 - ldr r4, [lr, #24] - mov r2, r1 - ldr r8, [r4, #0] - mov r3, #0 - rsb ip, r8, r5 - adds r7, ip, #4 - bmi .L203 - mov r1, r7, asr #2 - bl allot_array_internal - mov r1, r8 - mov r4, r0 - mov r2, r7 - add r0, r0, #8 - bl memcpy - bic r4, r4, #7 - add r3, r5, #4 - mov r5, r3 - orr r4, r4, #3 - str r4, [r5, #0] - ldmfd sp!, {r4, r7, r8, pc} -.L203: - mov r0, #11 - ldmfd sp!, {r4, r7, r8, lr} - b general_error -.L208: - .align 0 -.L207: - .word stack_chain - .comm errno, 4 @ 4 - .comm profiling, 4 @ 1 - .comm userenv, 160 @ 160 - .comm T, 4 @ 4 - .comm stack_chain, 4 @ 4 - .comm ds_size, 4 @ 4 - .comm rs_size, 4 @ 4 - .comm signal_number, 4 @ 4 - .comm signal_fault_addr, 4 @ 4 - .comm signal_callstack_top, 4 @ 4 - .comm secure_gc, 4 @ 1 - .comm data_heap, 4 @ 4 - .comm cards_offset, 4 @ 4 - .comm newspace, 4 @ 4 - .comm nursery, 4 @ 4 - .comm gc_time, 8 @ 8 - .comm minor_collections, 4 @ 4 - .comm cards_scanned, 4 @ 4 - .comm performing_gc, 4 @ 1 - .comm collecting_gen, 4 @ 4 - .comm collecting_code, 4 @ 1 - .comm collecting_aging_again, 4 @ 1 - .comm last_code_heap_scan, 4 @ 4 - .comm growing_data_heap, 4 @ 1 - .comm old_data_heap, 4 @ 4 - .comm gc_jmp, 44 @ 44 - .comm heap_scan_ptr, 4 @ 4 - .comm gc_off, 4 @ 1 - .comm extra_roots_region, 4 @ 4 - .comm extra_roots, 4 @ 4 - .comm bignum_zero, 4 @ 4 - .comm bignum_pos_one, 4 @ 4 - .comm bignum_neg_one, 4 @ 4 - .comm code_heap, 8 @ 8 - .comm data_relocation_base, 4 @ 4 - .comm code_relocation_base, 4 @ 4 - .comm posix_argc, 4 @ 4 - .comm posix_argv, 4 @ 4 - .def memcpy; .scl 2; .type 32; .endef - .def type_error; .scl 2; .type 32; .endef - .def safe_malloc; .scl 2; .type 32; .endef - .def alloc_segment; .scl 2; .type 32; .endef - .def dealloc_segment; .scl 2; .type 32; .endef - .def free; .scl 2; .type 32; .endef - .def allot_array_internal; .scl 2; .type 32; .endef - .def general_error; .scl 2; .type 32; .endef - .def memcpy; .scl 2; .type 32; .endef - .def dosym; .scl 2; .type 32; .endef - .def undefined; .scl 2; .type 32; .endef - .def exit; .scl 2; .type 32; .endef - .def to_fixnum; .scl 2; .type 32; .endef - .def unbox_char_string; .scl 2; .type 32; .endef - .def getenv; .scl 2; .type 32; .endef - .def box_char_string; .scl 2; .type 32; .endef - .def box_unsigned_8; .scl 2; .type 32; .endef - .def current_millis; .scl 2; .type 32; .endef - .def sleep_millis; .scl 2; .type 32; .endef - .def to_cell; .scl 2; .type 32; .endef - .def docol_profiling; .scl 2; .type 32; .endef - .def docol; .scl 2; .type 32; .endef - .def save_callstack_top; .scl 2; .type 32; .endef - .def to_boolean; .scl 2; .type 32; .endef - .def begin_scan; .scl 2; .type 32; .endef - .def next_object; .scl 2; .type 32; .endef - .section .drectve - .ascii " -export:nursery,data" - .ascii " -export:cards_offset,data" - .ascii " -export:stack_chain,data" - .ascii " -export:userenv,data" - .ascii " -export:profiling,data" - .ascii " -export:nest_stacks" - .ascii " -export:unnest_stacks" - .ascii " -export:save_stacks"