From b811d84eb694bfeb1a8a2bd403159e0610607c10 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Fri, 21 Apr 2023 14:28:27 +0100 Subject: [PATCH 1/4] Tweak the separator character in Compat.ml.in Use a character which mustn't be used elsewhere in the file. --- Compat.ml.in | 248 ++++++++++++++++++++++++++------------------------- Makefile | 2 +- 2 files changed, 126 insertions(+), 124 deletions(-) diff --git a/Compat.ml.in b/Compat.ml.in index cb80bb7..0e735af 100644 --- a/Compat.ml.in +++ b/Compat.ml.in @@ -8,137 +8,139 @@ (* Compatibility shims. Each line is prefixed with the compiler at which the line ceases to be necessary. A function introduced in OCaml 4.01, therefore, - is prefixed with "401:" *) + is prefixed with "401" followed by the separator character. The character + used as the separator must be unused in the rest of the file (e.g. `:` cannot + be used) *) -405:module Arg = struct -405: include Arg -405: -405: let trim_cr s = -405: let len = String.length s in -405: if len > 0 && String.get s (len - 1) = '\r' then -405: String.sub s 0 (len - 1) -405: else -405: s -405: -405: let read_aux trim sep file = -405: let ic = open_in_bin file in -405: let buf = Buffer.create 200 in -405: let words = ref [] in -405: let stash () = -405: let word = Buffer.contents buf in -405: let word = if trim then trim_cr word else word in -405: words := word :: !words; -405: Buffer.clear buf -405: in -405: begin -405: try while true do -405: let c = input_char ic in -405: if c = sep then stash () else Buffer.add_char buf c -405: done -405: with End_of_file -> () -405: end; -405: if Buffer.length buf > 0 then stash (); -405: close_in ic; -405: Array.of_list (List.rev !words) -405: -405: let read_arg = read_aux true '\n' -405: -405: let read_arg0 = read_aux false '\x00' -405: -405:end +405@module Arg = struct +405@ include Arg +405@ +405@ let trim_cr s = +405@ let len = String.length s in +405@ if len > 0 && String.get s (len - 1) = '\r' then +405@ String.sub s 0 (len - 1) +405@ else +405@ s +405@ +405@ let read_aux trim sep file = +405@ let ic = open_in_bin file in +405@ let buf = Buffer.create 200 in +405@ let words = ref [] in +405@ let stash () = +405@ let word = Buffer.contents buf in +405@ let word = if trim then trim_cr word else word in +405@ words := word :: !words; +405@ Buffer.clear buf +405@ in +405@ begin +405@ try while true do +405@ let c = input_char ic in +405@ if c = sep then stash () else Buffer.add_char buf c +405@ done +405@ with End_of_file -> () +405@ end; +405@ if Buffer.length buf > 0 then stash (); +405@ close_in ic; +405@ Array.of_list (List.rev !words) +405@ +405@ let read_arg = read_aux true '\n' +405@ +405@ let read_arg0 = read_aux false '\x00' +405@ +405@end -403:module Uchar = struct -403: let unsafe_of_int c = c -403: -403: let to_int c = c -403:end +403@module Uchar = struct +403@ let unsafe_of_int c = c +403@ +403@ let to_int c = c +403@end -406:module Buffer = struct -406: include Buffer -406: -402: let to_bytes = contents -402: -406: let add_utf_16le_uchar b u = match Uchar.to_int u with -406: | u when u < 0 -> assert false -406: | u when u <= 0xFFFF -> -406: add_char b (Char.unsafe_chr (u land 0xFF)); -406: add_char b (Char.unsafe_chr (u lsr 8)) -406: | u when u <= 0x10FFFF -> -406: let u' = u - 0x10000 in -406: let hi = 0xD800 lor (u' lsr 10) in -406: let lo = 0xDC00 lor (u' land 0x3FF) in -406: add_char b (Char.unsafe_chr (hi land 0xFF)); -406: add_char b (Char.unsafe_chr (hi lsr 8)); -406: add_char b (Char.unsafe_chr (lo land 0xFF)); -406: add_char b (Char.unsafe_chr (lo lsr 8)) -406: | _ -> assert false -406:end +406@module Buffer = struct +406@ include Buffer +406@ +402@ let to_bytes = contents +402@ +406@ let add_utf_16le_uchar b u = match Uchar.to_int u with +406@ | u when u < 0 -> assert false +406@ | u when u <= 0xFFFF -> +406@ add_char b (Char.unsafe_chr (u land 0xFF)); +406@ add_char b (Char.unsafe_chr (u lsr 8)) +406@ | u when u <= 0x10FFFF -> +406@ let u' = u - 0x10000 in +406@ let hi = 0xD800 lor (u' lsr 10) in +406@ let lo = 0xDC00 lor (u' land 0x3FF) in +406@ add_char b (Char.unsafe_chr (hi land 0xFF)); +406@ add_char b (Char.unsafe_chr (hi lsr 8)); +406@ add_char b (Char.unsafe_chr (lo land 0xFF)); +406@ add_char b (Char.unsafe_chr (lo lsr 8)) +406@ | _ -> assert false +406@end -402:module Bytes = struct -402: include String -402: -402: let blit_string = blit -402: let sub_string = sub -402: let of_string x = x -402: let to_string x = x -402: let cat = (^) -402:end +402@module Bytes = struct +402@ include String +402@ +402@ let blit_string = blit +402@ let sub_string = sub +402@ let of_string x = x +402@ let to_string x = x +402@ let cat = (^) +402@end -403:module Char = struct -403: include Char -403: -403: let lowercase_ascii c = -403: if (c >= 'A' && c <= 'Z') -403: then unsafe_chr(code c + 32) -403: else c -403: -403: let uppercase_ascii c = -403: if (c >= 'a' && c <= 'z') -403: then unsafe_chr(code c - 32) -403: else c -403:end +403@module Char = struct +403@ include Char +403@ +403@ let lowercase_ascii c = +403@ if (c >= 'A' && c <= 'Z') +403@ then unsafe_chr(code c + 32) +403@ else c +403@ +403@ let uppercase_ascii c = +403@ if (c >= 'a' && c <= 'z') +403@ then unsafe_chr(code c - 32) +403@ else c +403@end -408:module Option = struct -408: let some v = Some v -408: let value o ~default = match o with Some v -> v | None -> default -408:end +408@module Option = struct +408@ let some v = Some v +408@ let value o ~default = match o with Some v -> v | None -> default +408@end -407:module Stdlib = Pervasives +407@module Stdlib = Pervasives -404:module String = struct -404: include String -402: -402: let init n f = -402: let s = create n in -402: for i = 0 to n - 1 do -402: unsafe_set s i (f i) -402: done; -402: s -403: -403: let lowercase_ascii s = -403: init (length s) (fun i -> Char.lowercase_ascii (unsafe_get s i)) -403: let uppercase_ascii s = -403: init (length s) (fun i -> Char.uppercase_ascii (unsafe_get s i)) -404: -404: let split_on_char sep s = -404: let r = ref [] in -404: let j = ref (length s) in -404: for i = length s - 1 downto 0 do -404: if unsafe_get s i = sep then begin -404: r := sub s (i + 1) (!j - i - 1) :: !r; -404: j := i -404: end -404: done; -404: sub s 0 !j :: !r -404:end +404@module String = struct +404@ include String +402@ +402@ let init n f = +402@ let s = create n in +402@ for i = 0 to n - 1 do +402@ unsafe_set s i (f i) +402@ done; +402@ s +403@ +403@ let lowercase_ascii s = +403@ init (length s) (fun i -> Char.lowercase_ascii (unsafe_get s i)) +403@ let uppercase_ascii s = +403@ init (length s) (fun i -> Char.uppercase_ascii (unsafe_get s i)) +404@ +404@ let split_on_char sep s = +404@ let r = ref [] in +404@ let j = ref (length s) in +404@ for i = length s - 1 downto 0 do +404@ if unsafe_get s i = sep then begin +404@ r := sub s (i + 1) (!j - i - 1) :: !r; +404@ j := i +404@ end +404@ done; +404@ sub s 0 !j :: !r +404@end -401:module Sys = struct -401: include Sys -401: -401: let win32 = (Sys.os_type = "Win32") -401:end +401@module Sys = struct +401@ include Sys +401@ +401@ let win32 = (Sys.os_type = "Win32") +401@end -402:type bytes = string -402:let output_bytes = output_string +402@type bytes = string +402@let output_bytes = output_string -401:let ( |> ) x f = f x +401@let ( |> ) x f = f x diff --git a/Makefile b/Makefile index d00f378..f9b03a6 100644 --- a/Makefile +++ b/Makefile @@ -152,7 +152,7 @@ COMPAT_LEVEL := \ $(if $(call test_ver,40700),407)) Compat.ml: Compat.ml.in COMPILER-$(COMPAT_VERSION) - sed -e '$(if $(COMPAT_LEVEL),/^$(subst $(SPACE),:\|^,$(COMPAT_LEVEL)):/d;)s/^[0-9]*://' $< > $@ + sed -e '$(if $(COMPAT_LEVEL),/^$(subst $(SPACE),@\|^,$(COMPAT_LEVEL))@/d;)s/^[0-9]*@//' $< > $@ flexlink.exe: $(OBJS) $(RES) @echo Building flexlink.exe with TOOLCHAIN=$(TOOLCHAIN) for OCaml $(OCAML_VERSION) From 933e88344e9c4f377d6d228d986f01128501bda6 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Fri, 21 Apr 2023 14:29:11 +0100 Subject: [PATCH 2/4] Generate version.ml using $(file ...) Available since GNU make 4.0 (Oct 2013) --- Makefile | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/Makefile b/Makefile index f9b03a6..af28a86 100644 --- a/Makefile +++ b/Makefile @@ -31,10 +31,17 @@ MIN64CC = $(MINGW64_PREFIX)gcc CYGWIN64_PREFIX = x86_64-pc-cygwin- CYG64CC = $(CYGWIN64_PREFIX)gcc +define NEWLINE + + +endef +$(SPACE) := + version.ml: Makefile - echo "let version = \"$(VERSION)\"" > version.ml - echo "let mingw_prefix = \"$(MINGW_PREFIX)\"" >> version.ml - echo "let mingw64_prefix = \"$(MINGW64_PREFIX)\"" >> version.ml + $(file >$@,$\ + let version = "$(VERSION)"$(NEWLINE)$\ + let mingw_prefix = "$(MINGW_PREFIX)"$(NEWLINE)$\ + let mingw64_prefix = "$(MINGW64_PREFIX)") # Supported tool-chains From 588dcc845d3e0733d45374eb6a1a2af8136a1b58 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Fri, 21 Apr 2023 14:31:09 +0100 Subject: [PATCH 3/4] Ensure $(COMPAT_LEVEL) evaluated lazily --- Makefile | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/Makefile b/Makefile index af28a86..4fd732b 100644 --- a/Makefile +++ b/Makefile @@ -150,13 +150,13 @@ COMPILER-$(COMPAT_VERSION): test_ver = $(shell if [ $(COMPAT_VERSION) -ge $(1) ] ; then echo ge ; fi) # This list must be in order -COMPAT_LEVEL := \ - $(strip $(if $(call test_ver,40100),401) \ - $(if $(call test_ver,40200),402) \ - $(if $(call test_ver,40300),403) \ - $(if $(call test_ver,40500),405) \ - $(if $(call test_ver,40600),406) \ - $(if $(call test_ver,40700),407)) +COMPAT_LEVEL = $(eval COMPAT_LEVEL := \ + $$(strip $$(if $$(call test_ver,40100),401) \ + $$(if $$(call test_ver,40200),402) \ + $$(if $$(call test_ver,40300),403) \ + $$(if $$(call test_ver,40500),405) \ + $$(if $$(call test_ver,40600),406) \ + $$(if $$(call test_ver,40700),407)))$(COMPAT_LEVEL) Compat.ml: Compat.ml.in COMPILER-$(COMPAT_VERSION) sed -e '$(if $(COMPAT_LEVEL),/^$(subst $(SPACE),@\|^,$(COMPAT_LEVEL))@/d;)s/^[0-9]*@//' $< > $@ From 7f4b3e50ee36821c511c6544b3f7637ee5e07a54 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Fri, 21 Apr 2023 14:31:46 +0100 Subject: [PATCH 4/4] Allow building using native GNU make Avoid the use of sed when building Compat.ml and use the NUL device. --- .gitattributes | 1 + Compat.cmd | 29 +++++++++++++++++++++++++++++ Makefile | 30 +++++++++++++++++++++++++----- 3 files changed, 55 insertions(+), 5 deletions(-) create mode 100644 Compat.cmd diff --git a/.gitattributes b/.gitattributes index 7f3ce9c..3055d1d 100644 --- a/.gitattributes +++ b/.gitattributes @@ -2,3 +2,4 @@ msvs-detect text eol=lf checkenv text eol=lf +Compat.cmd text eol=crlf diff --git a/Compat.cmd b/Compat.cmd new file mode 100644 index 0000000..6230351 --- /dev/null +++ b/Compat.cmd @@ -0,0 +1,29 @@ +@setlocal +@echo off + +:: This can be done as (slightly long) one-liner, but embedded in Makefile it +:: encodes the knowledge that GNU make uses batch files internally, which is a +:: bit brittle. findstr /N is a trick to allow blank lines to be included. More +:: subtly, it allows tagged blank lines to be detected. +for /f "tokens=1* delims=:" %%a in ('findstr /N /R "^" %2') do ( + rem Handle blank lines in the file + if "%%b" equ "" ( + echo. + ) else ( + for /f "tokens=1* delims=@" %%l in ("%%b") do ( + rem If %%l == %%b then the line didn't contain @ - we already know the + rem line isn't blank. + if "%%l" equ "%%b" ( + echo %%l + ) else ( + if %1 lss %%l00 ( + if "%%m" equ "" ( + echo. + ) else ( + echo %%m + ) + ) + ) + ) + ) +) diff --git a/Makefile b/Makefile index 4fd732b..9415be8 100644 --- a/Makefile +++ b/Makefile @@ -8,12 +8,28 @@ VERSION = 0.42 all: flexlink.exe support -OCAML_CONFIG_FILE=$(shell cygpath -ad "$(shell ocamlopt -where 2>/dev/null)/Makefile.config" 2>/dev/null) +export override OCAML_DETECT_CMD = detect +SHELL_IS_CMD := \ + $(if $(filter %OCAML_DETECT_CMD%, $(shell echo %OCAML_DETECT_CMD%)),,true) +unexport OCAML_DETECT_CMD +undefine DETECT_WINDOWS_SHELL + +NULL_DEVICE := $(if $(SHELL_IS_CMD), NUL, /dev/null) + +ifeq ($(SHELL_IS_CMD),) +RM_F = rm -f $(1) +TOUCH = touch +else +RM_F = $(if $(wildcard $(1)),del /f $(subst /,\,$(wildcard ($1)))) +TOUCH = type NUL > +endif + +OCAML_CONFIG_FILE=$(shell cygpath -ad "$(shell ocamlopt -where 2>$(NULL_DEVICE))/Makefile.config" 2>$(NULL_DEVICE)) include $(OCAML_CONFIG_FILE) OCAMLOPT=ocamlopt EMPTY= SPACE=$(EMPTY) $(EMPTY) -OCAML_VERSION:=$(firstword $(subst ~, ,$(subst +, ,$(shell $(OCAMLOPT) -version 2>/dev/null)))) +OCAML_VERSION:=$(firstword $(subst ~, ,$(subst +, ,$(shell $(OCAMLOPT) -version 2>$(NULL_DEVICE))))) ifeq ($(OCAML_VERSION),) OCAML_VERSION:=0 COMPAT_VERSION:=0 @@ -144,8 +160,8 @@ build_mingw64: flexdll_mingw64.o flexdll_initer_mingw64.o OBJS = version.ml Compat.ml coff.ml cmdline.ml create_dll.ml reloc.ml COMPILER-$(COMPAT_VERSION): - rm -f COMPILER-* - touch COMPILER-$(COMPAT_VERSION) + $(call RM_F, COMPILER-*) + $(TOUCH) COMPILER-$(COMPAT_VERSION) test_ver = $(shell if [ $(COMPAT_VERSION) -ge $(1) ] ; then echo ge ; fi) @@ -159,11 +175,15 @@ COMPAT_LEVEL = $(eval COMPAT_LEVEL := \ $$(if $$(call test_ver,40700),407)))$(COMPAT_LEVEL) Compat.ml: Compat.ml.in COMPILER-$(COMPAT_VERSION) +ifeq ($(SHELL_IS_CMD),) sed -e '$(if $(COMPAT_LEVEL),/^$(subst $(SPACE),@\|^,$(COMPAT_LEVEL))@/d;)s/^[0-9]*@//' $< > $@ +else + Compat.cmd $(COMPAT_VERSION) $< > $@ +endif flexlink.exe: $(OBJS) $(RES) @echo Building flexlink.exe with TOOLCHAIN=$(TOOLCHAIN) for OCaml $(OCAML_VERSION) - rm -f flexlink.exe + $(call RM_F, flexlink.exe) $(RES_PREFIX) $(OCAMLOPT) -o flexlink.exe $(LINKFLAGS) $(OBJS) version.res: version.rc