diff -uNr a/weightless/COPYRIGHT b/weightless/COPYRIGHT --- a/weightless/COPYRIGHT false +++ b/weightless/COPYRIGHT 077727c62a2816a40b1a6a192a15b6a3bd8c8c962451db2618b97456bd8238882cb0518932b7defbcf53c6a9eb3dbd0e32773ce75a9c7ae7e8e0c18a05a7644b @@ -0,0 +1,4 @@ +The memory manipulation routines (adainclude/memcmp.c, +adainclude/memcpy.s, adainclude/memmove.s and adainclude/memset.c) +are Copyright © 2005-2020 Rich Felker, et al. and are licensed under +a standard MIT license. They were taken from musl libc. diff -uNr a/weightless/MANIFEST b/weightless/MANIFEST --- a/weightless/MANIFEST false +++ b/weightless/MANIFEST ce98038600fdf660c887ad515089f873fee1e8aa5dfbbd9ffab8f1c0b7d97da9b3acb65c1634acf3878d9ad1dc0ca9d8b395a051e5841d869877c74071457579 @@ -0,0 +1 @@ + 828710 weightless_genesis "Genesis." diff -uNr a/weightless/Makefile b/weightless/Makefile --- a/weightless/Makefile false +++ b/weightless/Makefile b3dcbe00e1e9ce3a193b8bad9a40a27e9e1119854f2d20a59641f0b1afd0f635d4f269c941b23337ed83c708f390372b7fc8c89391a6550ffd1f629b90c2edcf @@ -0,0 +1,35 @@ +PROJECT_FILE = weightless.gpr +ROOT_DIR := $(dir $(realpath $(lastword $(MAKEFILE_LIST)))) +TARGET = i686-pc-pe + +all: adalib/libgnat.a adalib/start.o + +adalib/start.o:adainclude/start.s + $(TARGET)-as -c $< -o $@ + +obj/memcpy.o:adainclude/memcpy.s + $(TARGET)-as -c $< -o $@ + +obj/memset.o:adainclude/memset.s + $(TARGET)-as -c $< -o $@ + +obj/memmove.o:adainclude/memmove.s + $(TARGET)-as -c $< -o $@ + +obj/memcmp.o:adainclude/memcmp.c + $(TARGET)-gcc -c $< -o $@ + +adalib/libgnat.a:adainclude/*.ads adainclude/*.adb obj/memcpy.o obj/memset.o obj/memmove.o obj/memcmp.o + gprbuild --target=$(TARGET) -P $(PROJECT_FILE) --RTS=$(ROOT_DIR) + $(TARGET)-ar r adalib/libgnat.a obj/memcpy.o + $(TARGET)-ar r adalib/libgnat.a obj/memset.o + $(TARGET)-ar r adalib/libgnat.a obj/memmove.o + $(TARGET)-ar r adalib/libgnat.a obj/memcmp.o + +clean: + gprclean -P $(PROJECT_FILE) + -rm adalib/start.o + -rm obj/memcpy.o + -rm obj/memset.o + -rm obj/memmove.o + -rm obj/memcmp.o diff -uNr a/weightless/README b/weightless/README --- a/weightless/README false +++ b/weightless/README 726a9b09905a56e8a5b1b692eab68a818eb2d4cdda3d45109ead98b53c49c4333add2e873f40e6cc05c60d5ddcb954de18bc950f0e62c1637286d92275146aec @@ -0,0 +1 @@ +Weightless Ada Runtime for DOS Protected Mode Interface diff -uNr a/weightless/adainclude/README b/weightless/adainclude/README --- a/weightless/adainclude/README false +++ b/weightless/adainclude/README 5fdbae897eb301a711bf95707f329517db540e34c182a5beec96e93d5d0d856cec2ed6b01c1191f865e8d1c45709a462c70c3005d4aa3676eb445d1479edf2e5 @@ -0,0 +1 @@ +Placeholder. diff -uNr a/weightless/adainclude/a-sequio.adb b/weightless/adainclude/a-sequio.adb --- a/weightless/adainclude/a-sequio.adb false +++ b/weightless/adainclude/a-sequio.adb 738f7e963612a87192c82a9c58620cea6316c860bf2f991a1b537db2f1bb2b2539353676133047c15b0be2b1871bd0f064b6aafa43272f4624adead28576278e @@ -0,0 +1,57 @@ +with System; +with Weightless.DPMI; use Weightless.DPMI; +with Weightless.DPMI.File_IO; use Weightless.DPMI.File_IO; + +package body Ada.Sequential_IO is + + procedure Open(File : in out File_Type; + Mode : File_Mode; + Name : String) is + Error : DOS_Error; + Requested_Access : File_Access; + DOS_Name : aliased String := Name & ASCII.NUL; + begin + case Mode is + when In_File => + Requested_Access := READ_ACCESS; + when Out_File => + Requested_Access := WRITE_ACCESS; + when Append_File => + raise Program_Error; -- not yet implemented! + end case; + + Error := Open_File(File_Handle(File), + Requested_Access, + DOS_Name'Address); + + if Error /= NO_ERROR_OCCURED then + raise Program_Error; + end if; + end Open; + + procedure Read(File : File_Type; + Item : out Element_Type) is + Error : DOS_Error; + Bytes_Read : Natural; + Size : constant Natural := + Element_Type'Size / System.Storage_Unit; + pragma Warnings(Off, + """Item"" may be referenced before it has a value"); + Input : aliased Element_Type := Item; + pragma Warnings(On, + """Item"" may be referenced before it has a value"); + begin + Error := Read_File(File_Handle(File), + Input'Address, + Size, + Bytes_Read); + + if Error /= NO_ERROR_OCCURED or else + Bytes_Read /= Size then + raise Program_Error; + end if; + + Item := Input; + end Read; + +end Ada.Sequential_IO; diff -uNr a/weightless/adainclude/a-sequio.ads b/weightless/adainclude/a-sequio.ads --- a/weightless/adainclude/a-sequio.ads false +++ b/weightless/adainclude/a-sequio.ads 2f50c286cea833482a0522fa22b90abc6d03b343a1fb1dc46d4265b828b70d7f270bf068eabd34e52aabd448320b9aa5bb4e0a88fc925dc263a695f42cd41f0c @@ -0,0 +1,28 @@ +with Weightless.DPMI.File_IO; + +generic + type Element_Type (<>) is private; +package Ada.Sequential_IO is + + type File_Type is limited private; + + type File_Mode is (In_File, Out_File, Append_File); + + -- File management + + procedure Open(File : in out File_Type; + Mode : File_Mode; + Name : String); + + -- Input and output operations + + procedure Read(File : File_Type; Item : out Element_Type); + +private + + type File_Type is new Weightless.DPMI.File_IO.File_Handle; + + pragma Inline(Open); + pragma Inline(Read); + +end Ada.Sequential_IO; diff -uNr a/weightless/adainclude/a-unccon.ads b/weightless/adainclude/a-unccon.ads --- a/weightless/adainclude/a-unccon.ads false +++ b/weightless/adainclude/a-unccon.ads a3d4587110b92438c5dcb9235c10ab972c8406d294b4f7b2251ed524d9c5181a51ef57ee63a9f7aace4972675933cc1d55064981923421ce40340b1fc04355e2 @@ -0,0 +1,6 @@ +generic + type Source(<>) is limited private; + type Target(<>) is limited private; +function Ada.Unchecked_Conversion(S : Source) return Target; +pragma Pure(Unchecked_Conversion); +pragma Import(Intrinsic, Unchecked_Conversion); diff -uNr a/weightless/adainclude/ada.ads b/weightless/adainclude/ada.ads --- a/weightless/adainclude/ada.ads false +++ b/weightless/adainclude/ada.ads afd9f2e878c5e67afbe8ae4e82de59b39092a7f734d0f372a9ef644cc9d545a9001eeab294467201562b6227fe202d5be852c197ccfff95845ba6d1b5d2d86a9 @@ -0,0 +1,4 @@ +package Ada is + pragma Pure; + +end Ada; diff -uNr a/weightless/adainclude/interfac.ads b/weightless/adainclude/interfac.ads --- a/weightless/adainclude/interfac.ads false +++ b/weightless/adainclude/interfac.ads 61b9c632383dc675fd9d64f96d83a33a35fd71161adbc8ac426531d64b672af8e6d4e6288dd7c04e0aa9f07f05485093d3238b3688b34e936766486b4bcc8416 @@ -0,0 +1,97 @@ +package Interfaces is + pragma Pure; + pragma Implementation_Defined; + + type Integer_8 is range -2 ** 7 .. 2 ** 7 - 1; + for Integer_8'Size use 8; + + type Integer_16 is range -2 ** 15 .. 2 ** 15 - 1; + for Integer_16'Size use 16; + + type Integer_32 is range -2 ** 31 .. 2 ** 31 - 1; + for Integer_32'Size use 32; + + type Integer_64 is range -2 ** 63 .. 2 ** 63 - 1; + for Integer_64'Size use 64; + + type Unsigned_8 is mod 2 ** 8; + for Unsigned_8'Size use 8; + + type Unsigned_16 is mod 2 ** 16; + for Unsigned_16'Size use 16; + + type Unsigned_32 is mod 2 ** 32; + for Unsigned_32'Size use 32; + + type Unsigned_64 is mod 2 ** 64; + for Unsigned_64'Size use 64; + + function Shift_Left (Value : Unsigned_8; + Amount : Natural) return Unsigned_8; + + function Shift_Right (Value : Unsigned_8; + Amount : Natural) return Unsigned_8; + + function Shift_Right_Arithmetic(Value : Unsigned_8; + Amount : Natural) return Unsigned_8; + + function Rotate_Left (Value : Unsigned_8; + Amount : Natural) return Unsigned_8; + + function Rotate_Right (Value : Unsigned_8; + Amount : Natural) return Unsigned_8; + + function Shift_Left (Value : Unsigned_16; + Amount : Natural) return Unsigned_16; + + function Shift_Right (Value : Unsigned_16; + Amount : Natural) return Unsigned_16; + + function Shift_Right_Arithmetic(Value : Unsigned_16; + Amount : Natural) return Unsigned_16; + + function Rotate_Left (Value : Unsigned_16; + Amount : Natural) return Unsigned_16; + + function Rotate_Right (Value : Unsigned_16; + Amount : Natural) return Unsigned_16; + + function Shift_Left (Value : Unsigned_32; + Amount : Natural) return Unsigned_32; + + function Shift_Right (Value : Unsigned_32; + Amount : Natural) return Unsigned_32; + + function Shift_Right_Arithmetic(Value : Unsigned_32; + Amount : Natural) return Unsigned_32; + + function Rotate_Left (Value : Unsigned_32; + Amount : Natural) return Unsigned_32; + + function Rotate_Right (Value : Unsigned_32; + Amount : Natural) return Unsigned_32; + + function Shift_Left (Value : Unsigned_64; + Amount : Natural) return Unsigned_64; + + function Shift_Right (Value : Unsigned_64; + Amount : Natural) return Unsigned_64; + + function Shift_Right_Arithmetic(Value : Unsigned_64; + Amount : Natural) return Unsigned_64; + + function Rotate_Left (Value : Unsigned_64; + Amount : Natural) return Unsigned_64; + + function Rotate_Right (Value : Unsigned_64; + Amount : Natural) return Unsigned_64; + + pragma Import(Intrinsic, Shift_Left); + pragma Import(Intrinsic, Shift_Right); + pragma Import(Intrinsic, Shift_Right_Arithmetic); + pragma Import(Intrinsic, Rotate_Left); + pragma Import(Intrinsic, Rotate_Right); + + pragma Warnings(Off); + +end Interfaces; diff -uNr a/weightless/adainclude/last_chance_handler.adb b/weightless/adainclude/last_chance_handler.adb --- a/weightless/adainclude/last_chance_handler.adb false +++ b/weightless/adainclude/last_chance_handler.adb a1504b9b258ec891d411f16319100296979518a82eb0f6fc5c7572a88d04c578ecdeff38ffd354c5b6b951333477e8f6e454ccefe7133ab5fe6fba3c49487489 @@ -0,0 +1,16 @@ +with Weightless.DPMI.Error_Reporting; use Weightless.DPMI.Error_Reporting; + +procedure Last_Chance_Handler(Source_Location : System.Address; + Line : Integer) is + pragma Suppress(All_Checks); + + Length : constant Natural := ASCIIZ_Length(Source_Location); + + File_Name : String(1 .. Length) + with Address => Source_Location, Alignment => 1; + + Line_String : constant String := Integer'Image(Line); +begin + Report_Error_and_Exit("unhandled exception at " & File_Name & + ":" & Line_String(2 .. Line_String'Last)); +end Last_Chance_Handler; diff -uNr a/weightless/adainclude/last_chance_handler.ads b/weightless/adainclude/last_chance_handler.ads --- a/weightless/adainclude/last_chance_handler.ads false +++ b/weightless/adainclude/last_chance_handler.ads 2496cb75f94a5e20a82fde087b38967d3a536f72939c30530b0824c17585a090ccb3b5958caf938ebd9ba06fb6e9405378078be5c02cd4fb7c6033b49563d25e @@ -0,0 +1,5 @@ +with System; + +procedure Last_Chance_Handler(Source_Location : System.Address; + Line : Integer); +pragma Export (C, Last_Chance_Handler, "__gnat_last_chance_handler"); diff -uNr a/weightless/adainclude/memcmp.c b/weightless/adainclude/memcmp.c --- a/weightless/adainclude/memcmp.c false +++ b/weightless/adainclude/memcmp.c 754ab31ecc9078c38322760a66a506b8b52a2bc2db0268a88612ba5d66342f27a9e2878fb0bf37fb347d7edea3e1f2db40083a53c0a6fe53a79b9d04f96083b3 @@ -0,0 +1,8 @@ +#include + +int memcmp(const void *vl, const void *vr, size_t n) +{ + const unsigned char *l=vl, *r=vr; + for (; n && *l == *r; n--, l++, r++); + return n ? *l-*r : 0; +} diff -uNr a/weightless/adainclude/memcpy.s b/weightless/adainclude/memcpy.s --- a/weightless/adainclude/memcpy.s false +++ b/weightless/adainclude/memcpy.s 153166c937ee2348cb5c5610368c7d1d691bdf20c5051d298d94097b1acac3152afe0e020b7d36224ba65ba466c876b7d4f3f6044cb1876ac514ff9a973f0dd1 @@ -0,0 +1,28 @@ +.global _memcpy +_memcpy: + push %esi + push %edi + mov 12(%esp),%edi + mov 16(%esp),%esi + mov 20(%esp),%ecx + mov %edi,%eax + cmp $4,%ecx + jc 1f + test $3,%edi + jz 1f +2: movsb + dec %ecx + test $3,%edi + jnz 2b +1: mov %ecx,%edx + shr $2,%ecx + rep + movsl + and $3,%edx + jz 1f +2: movsb + dec %edx + jnz 2b +1: pop %edi + pop %esi + ret diff -uNr a/weightless/adainclude/memmove.s b/weightless/adainclude/memmove.s --- a/weightless/adainclude/memmove.s false +++ b/weightless/adainclude/memmove.s fb7ca2e99c6f6bc3096240d72ee4325da4beee086521114f476f4321b5fc8a882c84837993a5cff22fbfda82c403f1643ac185cdad59181a4a6d324bc2a8eef0 @@ -0,0 +1,20 @@ +.global _memmove +_memmove: + mov 4(%esp),%eax + sub 8(%esp),%eax + cmp 12(%esp),%eax + jae _memcpy + push %esi + push %edi + mov 12(%esp),%edi + mov 16(%esp),%esi + mov 20(%esp),%ecx + lea -1(%edi,%ecx),%edi + lea -1(%esi,%ecx),%esi + std + rep movsb + cld + lea 1(%edi),%eax + pop %edi + pop %esi + ret diff -uNr a/weightless/adainclude/memset.s b/weightless/adainclude/memset.s --- a/weightless/adainclude/memset.s false +++ b/weightless/adainclude/memset.s 028aa459e200f80bdcff34f12b0705126199346d8475cc41e8fc86850f782bca015e788145037e9818d7a98151aebaa977ca47914f18c19c7d554e3d10208ad0 @@ -0,0 +1,75 @@ +.global _memset +_memset: + mov 12(%esp),%ecx + cmp $62,%ecx + ja 2f + + mov 8(%esp),%dl + mov 4(%esp),%eax + test %ecx,%ecx + jz 1f + + mov %dl,%dh + + mov %dl,(%eax) + mov %dl,-1(%eax,%ecx) + cmp $2,%ecx + jbe 1f + + mov %dx,1(%eax) + mov %dx,(-1-2)(%eax,%ecx) + cmp $6,%ecx + jbe 1f + + shl $16,%edx + mov 8(%esp),%dl + mov 8(%esp),%dh + + mov %edx,(1+2)(%eax) + mov %edx,(-1-2-4)(%eax,%ecx) + cmp $14,%ecx + jbe 1f + + mov %edx,(1+2+4)(%eax) + mov %edx,(1+2+4+4)(%eax) + mov %edx,(-1-2-4-8)(%eax,%ecx) + mov %edx,(-1-2-4-4)(%eax,%ecx) + cmp $30,%ecx + jbe 1f + + mov %edx,(1+2+4+8)(%eax) + mov %edx,(1+2+4+8+4)(%eax) + mov %edx,(1+2+4+8+8)(%eax) + mov %edx,(1+2+4+8+12)(%eax) + mov %edx,(-1-2-4-8-16)(%eax,%ecx) + mov %edx,(-1-2-4-8-12)(%eax,%ecx) + mov %edx,(-1-2-4-8-8)(%eax,%ecx) + mov %edx,(-1-2-4-8-4)(%eax,%ecx) + +1: ret + +2: movzbl 8(%esp),%eax + mov %edi,12(%esp) + imul $0x1010101,%eax + mov 4(%esp),%edi + test $15,%edi + mov %eax,-4(%edi,%ecx) + jnz 2f + +1: shr $2, %ecx + rep + stosl + mov 4(%esp),%eax + mov 12(%esp),%edi + ret + +2: xor %edx,%edx + sub %edi,%edx + and $15,%edx + mov %eax,(%edi) + mov %eax,4(%edi) + mov %eax,8(%edi) + mov %eax,12(%edi) + sub %edx,%ecx + add %edx,%edi + jmp 1b diff -uNr a/weightless/adainclude/s-assert.adb b/weightless/adainclude/s-assert.adb --- a/weightless/adainclude/s-assert.adb false +++ b/weightless/adainclude/s-assert.adb ae0bd61b28a65063bd41ce1cafb35f7ddf290b5ccccd2058364fbd0eea5e21d2a928f4c7369634cd97065af66df440a8ff72facc29fae5907f6110053370b430 @@ -0,0 +1,11 @@ +with Weightless.DPMI; use Weightless.DPMI; +with Weightless.DPMI.Error_Reporting; use Weightless.DPMI.Error_Reporting; + +package body System.Assertions is + + procedure Raise_Assert_Failure(Msg : String) is + begin + Report_Error_and_Exit(Msg); + end Raise_Assert_Failure; + +end System.Assertions; diff -uNr a/weightless/adainclude/s-assert.ads b/weightless/adainclude/s-assert.ads --- a/weightless/adainclude/s-assert.ads false +++ b/weightless/adainclude/s-assert.ads 3d55e6b0034241e54e448934a8f4ac022598294aa1eb40c8a776770bdf8250e8a90a6fcc7c67ff1dbefe106fb22e68ab103528611f3f3da15f917a81523bd120 @@ -0,0 +1,8 @@ +package System.Assertions is + + Assert_Failure : exception; + + procedure Raise_Assert_Failure(Msg : String); + pragma No_Return(Raise_Assert_Failure); + +end System.Assertions; diff -uNr a/weightless/adainclude/s-imgint.adb b/weightless/adainclude/s-imgint.adb --- a/weightless/adainclude/s-imgint.adb false +++ b/weightless/adainclude/s-imgint.adb 124dab01b6b8e38d68571b61cfa5accfdb04343771cfb094868e6ae4eeb1cded3ba9ddef04d3b765edee1125c3532a03e4e22a7842176c9e372bfbaec1d382fd @@ -0,0 +1,44 @@ +package body System.Img_Int is + + procedure Image_Integer (V : Integer; + S : in out String; + P : out Natural) is + pragma Assert (S'First = 1); + begin + if V >= 0 then + S (1) := ' '; + P := 1; + else + P := 0; + end if; + + Set_Image_Integer (V, S, P); + end Image_Integer; + + procedure Set_Image_Integer(V : Integer; + S : in out String; + P : in out Natural) is + procedure Set_Digits (T : Integer); + procedure Set_Digits (T : Integer) is + begin + if T <= -10 then + Set_Digits (T / 10); + P := P + 1; + S (P) := Character'Val (48 - (T rem 10)); + else + P := P + 1; + S (P) := Character'Val (48 - T); + end if; + end Set_Digits; + + begin + if V >= 0 then + Set_Digits (-V); + else + P := P + 1; + S (P) := '-'; + Set_Digits (V); + end if; + end Set_Image_Integer; + +end System.Img_Int; diff -uNr a/weightless/adainclude/s-imgint.ads b/weightless/adainclude/s-imgint.ads --- a/weightless/adainclude/s-imgint.ads false +++ b/weightless/adainclude/s-imgint.ads b05f82afd21e157951f60025977067d0a596580e9f4a13eb34840374f1807ccb25375ac9a215a0f6cbaa835af0939cc8e033b31221457725d5468be5c0afd586 @@ -0,0 +1,13 @@ +package System.Img_Int is + pragma Pure; + + procedure Image_Integer (V : Integer; + S : in out String; + P : out Natural); + pragma Inline(Image_Integer); + + procedure Set_Image_Integer(V : Integer; + S : in out String; + P : in out Natural); + +end System.Img_Int; diff -uNr a/weightless/adainclude/s-imguns.adb b/weightless/adainclude/s-imguns.adb --- a/weightless/adainclude/s-imguns.adb false +++ b/weightless/adainclude/s-imguns.adb 35f0eaa803d0121a5b967467e4bc1f88dc3ec68283803b6bce0c15301e78792e19fd1e6c8320ee6d75f869ef0e7d056bfa3b849fb6b6989f363a618c7d5ad9e7 @@ -0,0 +1,36 @@ +with System.Unsigned_Types; use System.Unsigned_Types; + +package body System.Img_Uns is + + procedure Image_Unsigned (V : Unsigned; + S : in out String; + P : out Natural) is + pragma Assert(S'First = 1); + begin + S (1) := ' '; + P := 1; + + Set_Image_Unsigned(V, S, P); + end Image_Unsigned; + + procedure Set_Image_Unsigned(V : Unsigned; + S : in out String; + P : in out Natural) is + procedure Set_Digits(T : Unsigned); + procedure Set_Digits(T : Unsigned) is + begin + if T >= 10 then + Set_Digits(T / 10); + P := P + 1; + S (P) := Character'Val(48 + (T rem 10)); + + else + P := P + 1; + S (P) := Character'Val(48 + T); + end if; + end Set_Digits; + begin + Set_Digits(V); + end Set_Image_Unsigned; + +end System.Img_Uns; diff -uNr a/weightless/adainclude/s-imguns.ads b/weightless/adainclude/s-imguns.ads --- a/weightless/adainclude/s-imguns.ads false +++ b/weightless/adainclude/s-imguns.ads 1eb3cdc6339e09fbdaae788baaa5f4829667cede22a46be934eee93521baba3b851e1f3e08c832fd741ee5b89a7fc20b7f90cd2db62237ae00f23caa1173c5a0 @@ -0,0 +1,15 @@ +with System.Unsigned_Types; + +package System.Img_Uns is + pragma Pure; + + procedure Image_Unsigned (V : System.Unsigned_Types.Unsigned; + S : in out String; + P : out Natural); + pragma Inline(Image_Unsigned); + + procedure Set_Image_Unsigned(V : System.Unsigned_Types.Unsigned; + S : in out String; + P : in out Natural); + +end System.Img_Uns; diff -uNr a/weightless/adainclude/s-maccod.ads b/weightless/adainclude/s-maccod.ads --- a/weightless/adainclude/s-maccod.ads false +++ b/weightless/adainclude/s-maccod.ads 363c8dc8670e66cebe1c1955e1fb5b1d87727b2d689d3a1bf71184294f0fbd36041dd2a74ef83ef2015765812eeff7e178bd4705e670a0be5f8683f804974f6f @@ -0,0 +1,78 @@ +package System.Machine_Code is + pragma Pure; + pragma Implementation_Defined; + + type Asm_Input_Operand is private; + type Asm_Output_Operand is private; + + No_Input_Operands : constant Asm_Input_Operand; + No_Output_Operands : constant Asm_Output_Operand; + + type Asm_Input_Operand_List is + array (Integer range <>) of Asm_Input_Operand; + + type Asm_Output_Operand_List is + array (Integer range <>) of Asm_Output_Operand; + + type Asm_Insn is private; + + procedure Asm(Template : String; + Outputs : Asm_Output_Operand_List; + Inputs : Asm_Input_Operand_List; + Clobber : String := ""; + Volatile : Boolean := False); + + procedure Asm(Template : String; + Outputs : Asm_Output_Operand := No_Output_Operands; + Inputs : Asm_Input_Operand_List; + Clobber : String := ""; + Volatile : Boolean := False); + + procedure Asm(Template : String; + Outputs : Asm_Output_Operand_List; + Inputs : Asm_Input_Operand := No_Input_Operands; + Clobber : String := ""; + Volatile : Boolean := False); + + procedure Asm(Template : String; + Outputs : Asm_Output_Operand := No_Output_Operands; + Inputs : Asm_Input_Operand := No_Input_Operands; + Clobber : String := ""; + Volatile : Boolean := False); + + function Asm(Template : String; + Outputs : Asm_Output_Operand_List; + Inputs : Asm_Input_Operand_List; + Clobber : String := ""; + Volatile : Boolean := False) return Asm_Insn; + + function Asm(Template : String; + Outputs : Asm_Output_Operand := No_Output_Operands; + Inputs : Asm_Input_Operand_List; + Clobber : String := ""; + Volatile : Boolean := False) return Asm_Insn; + + function Asm(Template : String; + Outputs : Asm_Output_Operand_List; + Inputs : Asm_Input_Operand := No_Input_Operands; + Clobber : String := ""; + Volatile : Boolean := False) return Asm_Insn; + + function Asm(Template : String; + Outputs : Asm_Output_Operand := No_Output_Operands; + Inputs : Asm_Input_Operand := No_Input_Operands; + Clobber : String := ""; + Volatile : Boolean := False) return Asm_Insn; + + pragma Import(Intrinsic, Asm); + +private + + type Asm_Input_Operand is new Integer; + type Asm_Output_Operand is new Integer; + type Asm_Insn is new Integer; + + No_Input_Operands : constant Asm_Input_Operand := 0; + No_Output_Operands : constant Asm_Output_Operand := 0; + +end System.Machine_Code; diff -uNr a/weightless/adainclude/s-stoele.adb b/weightless/adainclude/s-stoele.adb --- a/weightless/adainclude/s-stoele.adb false +++ b/weightless/adainclude/s-stoele.adb e9e195bf972c34404b05781210514fa08950dae9075f89dce4ae40b83c26c051921583b758c2e457a0f1bc602fc4144487263b306ba334109d1857eea13b0fe5 @@ -0,0 +1,59 @@ +pragma Compiler_Unit_Warning; + +with Ada.Unchecked_Conversion; + +package body System.Storage_Elements is + + pragma Suppress (All_Checks); + + function To_Address is + new Ada.Unchecked_Conversion (Storage_Offset, Address); + function To_Offset is + new Ada.Unchecked_Conversion (Address, Storage_Offset); + + function To_Address(Value : Integer_Address) return Address is + begin + return Address(Value); + end To_Address; + + function To_Integer(Value : Address) return Integer_Address is + begin + return Integer_Address(Value); + end To_Integer; + + function "+" (Left : Address; Right : Storage_Offset) return Address is + begin + return Storage_Elements.To_Address + (To_Integer(Left) + To_Integer(To_Address(Right))); + end "+"; + + function "+" (Left : Storage_Offset; Right : Address) return Address is + begin + return Storage_Elements.To_Address + (To_Integer(To_Address(Left)) + To_Integer(Right)); + end "+"; + + function "-" (Left : Address; Right : Storage_Offset) return Address is + begin + return Storage_Elements.To_Address + (To_Integer(Left) - To_Integer(To_Address(Right))); + end "-"; + + function "-" (Left, Right : Address) return Storage_Offset is + begin + return To_Offset(Storage_Elements.To_Address(To_Integer(Left) - + To_Integer(Right))); + end "-"; + + function "mod"(Left : Address; + Right : Storage_Offset) return Storage_Offset is + begin + if Right > 0 then + return Storage_Offset(To_Integer(Left) mod + Integer_Address(Right)); + else + raise Constraint_Error; + end if; + end "mod"; + +end System.Storage_Elements; diff -uNr a/weightless/adainclude/s-stoele.ads b/weightless/adainclude/s-stoele.ads --- a/weightless/adainclude/s-stoele.ads false +++ b/weightless/adainclude/s-stoele.ads a5a402aaebd5a4e0567b974a2a4fd73091ec8f78a1712852fab4375ed0c0b6b245ee4eb971d909216f18d2de5087bc008ab4b36067a2723c49c7ee2d962348cc @@ -0,0 +1,59 @@ +pragma Compiler_Unit_Warning; + +package System.Storage_Elements is + pragma Pure; + + type Storage_Offset is range + -(2 ** (Integer'(Standard'Address_Size) - 1)) .. + +(2 ** (Integer'(Standard'Address_Size) - 1)) - Long_Long_Integer'(1); + + subtype Storage_Count is Storage_Offset range 0 .. Storage_Offset'Last; + + type Storage_Element is mod 2 ** Storage_Unit; + for Storage_Element'Size use Storage_Unit; + + pragma Universal_Aliasing (Storage_Element); + + type Storage_Array is + array (Storage_Offset range <>) of aliased Storage_Element; + for Storage_Array'Component_Size use Storage_Unit; + + function "+" (Left : Address; Right : Storage_Offset) return Address; + pragma Convention(Intrinsic, "+"); + pragma Inline_Always("+"); + pragma Pure_Function("+"); + + function "+" (Left : Storage_Offset; Right : Address) return Address; + pragma Convention(Intrinsic, "+"); + pragma Inline_Always("+"); + pragma Pure_Function ("+"); + + function "-" (Left : Address; Right : Storage_Offset) return Address; + pragma Convention (Intrinsic, "-"); + pragma Inline_Always ("-"); + pragma Pure_Function ("-"); + + function "-" (Left, Right : Address) return Storage_Offset; + pragma Convention (Intrinsic, "-"); + pragma Inline_Always ("-"); + pragma Pure_Function ("-"); + + function "mod"(Left : Address; + Right : Storage_Offset) return Storage_Offset; + pragma Convention(Intrinsic, "mod"); + pragma Inline_Always("mod"); + pragma Pure_Function("mod"); + + type Integer_Address is mod Memory_Size; + + function To_Address(Value : Integer_Address) return Address; + pragma Convention(Intrinsic, To_Address); + pragma Inline_Always(To_Address); + pragma Pure_Function(To_Address); + + function To_Integer(Value : Address) return Integer_Address; + pragma Convention(Intrinsic, To_Integer); + pragma Inline_Always(To_Integer); + pragma Pure_Function(To_Integer); + +end System.Storage_Elements; diff -uNr a/weightless/adainclude/s-unstyp.ads b/weightless/adainclude/s-unstyp.ads --- a/weightless/adainclude/s-unstyp.ads false +++ b/weightless/adainclude/s-unstyp.ads f0c08e82b2392acedabff0a210d30b6e37729426fa11f77b3ff63a06951027aa0887e8189957a591637ba5ece8fcddfe580b806491ab942b02e36811c902d19c @@ -0,0 +1,118 @@ +package System.Unsigned_Types is + pragma Pure; + + type Short_Short_Unsigned is mod 2 ** Short_Short_Integer'Size; + type Short_Unsigned is mod 2 ** Short_Integer'Size; + type Unsigned is mod 2 ** Integer'Size; + type Long_Unsigned is mod 2 ** Long_Integer'Size; + type Long_Long_Unsigned is mod 2 ** Long_Long_Integer'Size; + + type Float_Unsigned is mod 2 ** Float'Size; + + function Shift_Left (Value : Short_Short_Unsigned; + Amount : Natural) + return Short_Short_Unsigned; + + function Shift_Right (Value : Short_Short_Unsigned; + Amount : Natural) + return Short_Short_Unsigned; + + function Shift_Right_Arithmetic(Value : Short_Short_Unsigned; + Amount : Natural) + return Short_Short_Unsigned; + + function Rotate_Left (Value : Short_Short_Unsigned; + Amount : Natural) + return Short_Short_Unsigned; + + function Rotate_Right (Value : Short_Short_Unsigned; + Amount : Natural) + return Short_Short_Unsigned; + + function Shift_Left (Value : Short_Unsigned; + Amount : Natural) + return Short_Unsigned; + + function Shift_Right (Value : Short_Unsigned; + Amount : Natural) + return Short_Unsigned; + + function Shift_Right_Arithmetic(Value : Short_Unsigned; + Amount : Natural) + return Short_Unsigned; + + function Rotate_Left (Value : Short_Unsigned; + Amount : Natural) + return Short_Unsigned; + + function Rotate_Right (Value : Short_Unsigned; + Amount : Natural) + return Short_Unsigned; + + function Shift_Left (Value : Unsigned; + Amount : Natural) + return Unsigned; + + function Shift_Right (Value : Unsigned; + Amount : Natural) + return Unsigned; + + function Shift_Right_Arithmetic(Value : Unsigned; + Amount : Natural) + return Unsigned; + + function Rotate_Left (Value : Unsigned; + Amount : Natural) + return Unsigned; + + function Rotate_Right (Value : Unsigned; + Amount : Natural) + return Unsigned; + + function Shift_Left (Value : Long_Unsigned; + Amount : Natural) + return Long_Unsigned; + + function Shift_Right (Value : Long_Unsigned; + Amount : Natural) + return Long_Unsigned; + + function Shift_Right_Arithmetic(Value : Long_Unsigned; + Amount : Natural) + return Long_Unsigned; + + function Rotate_Left (Value : Long_Unsigned; + Amount : Natural) + return Long_Unsigned; + + function Rotate_Right (Value : Long_Unsigned; + Amount : Natural) + return Long_Unsigned; + + function Shift_Left (Value : Long_Long_Unsigned; + Amount : Natural) + return Long_Long_Unsigned; + + function Shift_Right (Value : Long_Long_Unsigned; + Amount : Natural) + return Long_Long_Unsigned; + + function Shift_Right_Arithmetic(Value : Long_Long_Unsigned; + Amount : Natural) + return Long_Long_Unsigned; + + function Rotate_Left (Value : Long_Long_Unsigned; + Amount : Natural) + return Long_Long_Unsigned; + + function Rotate_Right (Value : Long_Long_Unsigned; + Amount : Natural) + return Long_Long_Unsigned; + + pragma Import(Intrinsic, Shift_Left); + pragma Import(Intrinsic, Shift_Right); + pragma Import(Intrinsic, Shift_Right_Arithmetic); + pragma Import(Intrinsic, Rotate_Left); + pragma Import(Intrinsic, Rotate_Right); + +end System.Unsigned_Types; diff -uNr a/weightless/adainclude/s-valint.adb b/weightless/adainclude/s-valint.adb --- a/weightless/adainclude/s-valint.adb false +++ b/weightless/adainclude/s-valint.adb 777008977de480def25c9461293ffd4950588f19dcb5ed184b461f9fb12ac46b3e0e3efbe72f0cad80fffcba6692acea9eb3d2a26f7eb8d1f7346a3e226bc24a @@ -0,0 +1,17 @@ +package body System.Val_Int is + + function Value_Integer(Str : String) return Integer is + Acc : Integer := 0; + Base : Integer := 1; + begin + for i in reverse Str'Range loop + if Character'Pos(Str(i)) >= 16#30# + and Character'Pos(Str(i)) <= 16#39# then + Acc := Acc + ((Character'Pos(Str(i)) - 16#30#) * Base); + Base := Base * 10; + end if; + end loop; + return Acc; + end Value_Integer; + +end System.Val_Int; diff -uNr a/weightless/adainclude/s-valint.ads b/weightless/adainclude/s-valint.ads --- a/weightless/adainclude/s-valint.ads false +++ b/weightless/adainclude/s-valint.ads 13948373f2b7e8f324d598532caae74dc039fba54ea8ce3bc8bb7f6aa811a8ea3d56b71bad1eaad288891e487bd6c250d2276fb266995f79e39b1c0f9a109be3 @@ -0,0 +1,6 @@ +package System.Val_Int is + pragma Pure; + + function Value_Integer(Str : String) return Integer; + +end System.Val_Int; diff -uNr a/weightless/adainclude/start.s b/weightless/adainclude/start.s --- a/weightless/adainclude/start.s false +++ b/weightless/adainclude/start.s 4895f973891d35cf94b48000eae958cddb52720a1839669d39cb8851bf663f26311432f00be8eaa5c2d194de6f9b54138104c3c442a11e2e2e2da45d5a256789 @@ -0,0 +1,48 @@ + .global _start + .global ___psp_address + .global ___environment_address + .global ___chkstk_ms + + .text + +_start: + mov $0x6,%ax /* get segment base address */ + + push %es + pop %bx /* psp segment */ + int $0x31 + + jc _catastrophic_failure + + mov %dx,___psp_address + mov %cx,___psp_address + 2 + + mov %es:0x2c,%bx /* environment segment */ + int $0x31 + + jc _catastrophic_failure + + mov %dx,___environment_address + mov %cx,___environment_address + 2 + + push %ds + pop %es /* es = ds */ + + call _run + movl $0x4c00,%eax /* return 0 */ + int $0x21 + +_catastrophic_failure: + mov $2,%ah + mov $21,%dl + int $0x21 + mov $0x4c80,%eax /* return 128 */ + int $0x21 + + .data + +___psp_address: + .long 0 + +___environment_address: + .long 0 diff -uNr a/weightless/adainclude/system.ads b/weightless/adainclude/system.ads --- a/weightless/adainclude/system.ads false +++ b/weightless/adainclude/system.ads 00f9ec91010646275f92d743025630d92e99f33584a3531b92d51aa7d44cf4f1eda64a445d9c82291eb3f898cb9f6db9bfcf0e8e19169b5c075efac6ada4d66b @@ -0,0 +1,87 @@ +package System is + pragma Pure; + + type Name is (SYSTEM_NAME_WARD); + System_Name : constant Name := SYSTEM_NAME_WARD; + + Min_Int : constant := Long_Integer'First; + Max_Int : constant := Long_Integer'Last; + + Max_Binary_Modulus : constant := 2 ** Long_Integer'Size; + Max_Nonbinary_Modulus : constant := 2 ** Integer'Size - 1; + + Max_Base_Digits : constant := Long_Float'Digits; + Max_Digits : constant := Long_Float'Digits; + + Max_Mantissa : constant := 31; + Fine_Delta : constant := 2.0 ** (-Max_Mantissa); + + Tick : constant := 0.000_001; + + type Address is private; + pragma Preelaborable_Initialization (Address); + Null_Address : constant Address; + + Storage_Unit : constant := 8; + Word_Size : constant := 4 * Storage_Unit; + Memory_Size : constant := 2 ** 32; + + function "<" (Left, Right : Address) return Boolean; + function "<=" (Left, Right : Address) return Boolean; + function ">" (Left, Right : Address) return Boolean; + function ">=" (Left, Right : Address) return Boolean; + function "=" (Left, Right : Address) return Boolean; + + pragma Import (Intrinsic, "<"); + pragma Import (Intrinsic, "<="); + pragma Import (Intrinsic, ">"); + pragma Import (Intrinsic, ">="); + pragma Import (Intrinsic, "="); + + type Bit_Order is (High_Order_First, Low_Order_First); + Default_Bit_Order : constant Bit_Order := Low_Order_First; + pragma Warnings (Off, Default_Bit_Order); + + Max_Priority : constant Positive := 97; + Max_Interrupt_Priority : constant Positive := 98; + + subtype Any_Priority is Integer range 0 .. 98; + subtype Priority is Any_Priority range 0 .. 97; + subtype Interrupt_Priority is Any_Priority range 98 .. 98; + + Default_Priority : constant Priority := 48; + +private + + type Address is mod Memory_Size; + Null_Address : constant Address := 0; + + Run_Time_Name : constant String := + "Weightless Ada Runtime for DPMI"; + Backend_Divide_Checks : constant Boolean := False; + Backend_Overflow_Checks : constant Boolean := True; + Command_Line_Args : constant Boolean := False; + Configurable_Run_Time : constant Boolean := True; + Denorm : constant Boolean := True; + Duration_32_Bits : constant Boolean := False; + Exit_Status_Supported : constant Boolean := False; + Fractional_Fixed_Ops : constant Boolean := False; + Frontend_Layout : constant Boolean := False; + Machine_Overflows : constant Boolean := False; + Machine_Rounds : constant Boolean := True; + Preallocated_Stacks : constant Boolean := False; + Signed_Zeros : constant Boolean := True; + Stack_Check_Default : constant Boolean := False; + Stack_Check_Probes : constant Boolean := True; + Stack_Check_Limits : constant Boolean := False; + Support_Aggregates : constant Boolean := True; + Support_Atomic_Primitives : constant Boolean := True; + Support_Composite_Assign : constant Boolean := True; + Support_Composite_Compare : constant Boolean := True; + Support_Long_Shifts : constant Boolean := True; + Always_Compatible_Rep : constant Boolean := False; + Suppress_Standard_Library : constant Boolean := True; + Use_Ada_Main_Program_Name : constant Boolean := False; + ZCX_By_Default : constant Boolean := False; + +end System; diff -uNr a/weightless/adainclude/weightless-dpmi-character_io.adb b/weightless/adainclude/weightless-dpmi-character_io.adb --- a/weightless/adainclude/weightless-dpmi-character_io.adb false +++ b/weightless/adainclude/weightless-dpmi-character_io.adb 16b191ec741e2d6b0cbf3a5c059ae0f73ab219d9333fec778cf7962b71dc2503e26617e3cfa0c65e1069e776625a3635da5c470e2cf612f160ce436a82c3e1b4 @@ -0,0 +1,16 @@ +with System.Machine_Code; use System.Machine_Code; +with Weightless.DPMI.System_Calls; use Weightless.DPMI.System_Calls; + +package body Weightless.DPMI.Character_IO is + + procedure Write_Standard_Output(Char : in Character) is + Written_Char : Character; + begin + Asm("int $0x21", + Inputs => (Unsigned_16'Asm_Input("a", SYSCALL_STD_CON_OUTPUT), + Character'Asm_Input("d", Char)), + Outputs => Character'Asm_Output("=a", Written_Char), + Volatile => True); + end Write_Standard_Output; + +end Weightless.DPMI.Character_IO; diff -uNr a/weightless/adainclude/weightless-dpmi-character_io.ads b/weightless/adainclude/weightless-dpmi-character_io.ads --- a/weightless/adainclude/weightless-dpmi-character_io.ads false +++ b/weightless/adainclude/weightless-dpmi-character_io.ads ee7716c2999d05cf4a7521678d3cbc57a308c4b9ecb50e5106ba94835e4ce11990aaddee30d5699f347624a9ab8fc31eec69825e7476416bd2818a2324b7a935 @@ -0,0 +1,5 @@ +package Weightless.DPMI.Character_IO is + + procedure Write_Standard_Output(char : in Character); + +end Weightless.DPMI.Character_IO; diff -uNr a/weightless/adainclude/weightless-dpmi-error_reporting.adb b/weightless/adainclude/weightless-dpmi-error_reporting.adb --- a/weightless/adainclude/weightless-dpmi-error_reporting.adb false +++ b/weightless/adainclude/weightless-dpmi-error_reporting.adb 9fbb1f3a2466e5a0c3a9f97c4b3454c7a37e786240e0ffb595be6e9dd8e3e7553e3c381a32bb0f55ae33f20f0521d397a293526643eb79c23c6cca50455c95bb @@ -0,0 +1,69 @@ +with System.Storage_Elements; use System.Storage_Elements; +with Weightless.DPMI.File_IO; use Weightless.DPMI.File_IO; +with Weightless.DPMI.Process_Control; use Weightless.DPMI.Process_Control; + +package body Weightless.DPMI.Error_Reporting is + + procedure Report_Error_and_Exit(Message : String) is + Environment_Address : System.Address; + pragma Import(C, Environment_Address, + "__environment_address"); + + Length : Natural; + Addr : System.Address := Environment_Address; + begin + Environment_Loop: + loop + Length := ASCIIZ_Length(Addr); + Addr := Addr + Storage_Offset(Length) + 1; + exit Environment_Loop when Length = 0; + end loop Environment_Loop; + + Addr := Addr + 2; + Length := ASCIIZ_Length(Addr); + + declare + Program_Name : String(1 .. Length) + with Address => Addr, Alignment => 1; + begin + Write_to_Standard_Error(Program_Name); + Write_to_Standard_Error(": "); + end; + + Write_to_Standard_Error(Message); + Write_to_Standard_Error(ASCII.CR & ASCII.LF); + + Terminate_Program(128); + end Report_Error_and_Exit; + + function Peek(Addr : System.Address) return Character is + Char : Character with Address => addr, Alignment => 1; + begin + return Char; + end Peek; + + function ASCIIZ_Length(Addr : System.Address) return Natural is + Length : Natural := 0; + Current_Addr : System.Address := Addr; + begin + while Peek(Current_Addr) /= ASCII.NUL loop + Length := Length + 1; + Current_Addr := Current_Addr + 1; + end loop; + + return Length; + end ASCIIZ_Length; + + procedure Write_to_Standard_Error(Item : String) is + Discard_Error : DOS_Error; + Discard_Bytes_Written : Natural; + pragma Unreferenced(Discard_Error); + pragma Unreferenced(Discard_Bytes_Written); + begin + Discard_Error := Write_File(STANDARD_ERROR, + Item'Address, + Item'Length, + Discard_Bytes_Written); + end Write_to_Standard_Error; + +end Weightless.DPMI.Error_Reporting; diff -uNr a/weightless/adainclude/weightless-dpmi-error_reporting.ads b/weightless/adainclude/weightless-dpmi-error_reporting.ads --- a/weightless/adainclude/weightless-dpmi-error_reporting.ads false +++ b/weightless/adainclude/weightless-dpmi-error_reporting.ads cfb5cf5ec36427de44e378e80a381e8cd53bd8e9ac39ccf516ad93ae98a6319dee0af28926cc52dd6ad18d1c4a7551fb5737e20547d3951cfbc18ac3814e1495 @@ -0,0 +1,16 @@ +with System; + +package Weightless.DPMI.Error_Reporting is + + procedure Report_Error_and_Exit(Message : String); + pragma No_Return(Report_Error_and_Exit); + + function Peek (Addr : System.Address) return Character; + + function ASCIIZ_Length (Addr : System.Address) return Natural; + +private + + procedure Write_to_Standard_Error(Item : String); + +end Weightless.DPMI.Error_Reporting; diff -uNr a/weightless/adainclude/weightless-dpmi-file_io.adb b/weightless/adainclude/weightless-dpmi-file_io.adb --- a/weightless/adainclude/weightless-dpmi-file_io.adb false +++ b/weightless/adainclude/weightless-dpmi-file_io.adb 037b976f3f4d4f0d60c41afa3dd7c9c50684194a24e054040fdc5ecd59fffe5c810189a6b4df2c27bcada9829fda36e4a3a105623661d0849f07b292ca95f560 @@ -0,0 +1,81 @@ +with System.Machine_Code; use System.Machine_Code; +with Weightless.DPMI; use Weightless.DPMI; +with Weightless.DPMI.System_Calls; use Weightless.DPMI.System_Calls; + +package body Weightless.DPMI.File_IO is + + function Open_File(File : out File_Handle; + Mode : in File_Access; + Name : in System.Address) + return DOS_Error is + ErrorP : Unsigned_8; + Output : Unsigned_32; + begin + Asm("int $0x21" & ASCII.LF & ASCII.HT & + "setc %0", + Inputs => (Unsigned_16'Asm_Input("a", SYSCALL_OPEN or + Unsigned_16(File_Access'Enum_Rep(Mode))), + System.Address'Asm_Input("d", Name)), + Outputs => (Unsigned_8'Asm_Output("=g", ErrorP), + Unsigned_32'Asm_Output("=a", Output)), + Volatile => True); + if ErrorP = 0 then + File := output; + return NO_ERROR_OCCURED; + else + return DOS_Error'Enum_Val(output); + end if; + end; + + function Read_File(File : in File_Handle; + Buffer_Address : in System.Address; + Bytes_to_Read : in Natural; + Bytes_Read : out Natural) + return DOS_Error is + ErrorP : Unsigned_8; + Output : Unsigned_32; + begin + Asm("int $0x21" & ASCII.LF & ASCII.HT & + "setc %0", + Inputs => (Unsigned_16'Asm_Input("a", SYSCALL_READ), + Unsigned_32'Asm_Input("b", File), + Unsigned_32'Asm_Input("c", Unsigned_32(Bytes_to_Read)), + System.Address'Asm_Input("d", Buffer_Address)), + Outputs => (Unsigned_8'Asm_Output("=g", ErrorP), + Unsigned_32'Asm_Output("=a", Output)), + Volatile => True); + if ErrorP = 0 then + Bytes_Read := Natural(Output); + return NO_ERROR_OCCURED; + else + return DOS_Error'Enum_Val(Output); + end if; + end Read_File; + + function Write_File(File : in File_Handle; + Buffer_Address : in System.Address; + Bytes_to_Write : in Natural; + Bytes_Written : out Natural) + return DOS_Error is + ErrorP : Unsigned_8; + Output : Unsigned_32; + begin + Asm("int $0x21" & ASCII.LF & ASCII.HT & + "setc %0", + Inputs => (Unsigned_16'Asm_Input("a", SYSCALL_WRITE), + Unsigned_32'Asm_Input("b", File), + Unsigned_32'Asm_Input("c", + Unsigned_32(Bytes_to_Write)), + System.Address'Asm_Input("d", Buffer_Address)), + Outputs => (Unsigned_8'Asm_Output("=g", ErrorP), + Unsigned_32'Asm_Output("=a", Output)), + Volatile => True); + if ErrorP = 0 then + Bytes_Written := Natural(Output); + return NO_ERROR_OCCURED; + else + return DOS_Error'Enum_Val(Output); + end if; + end Write_File; + +end Weightless.DPMI.File_IO; diff -uNr a/weightless/adainclude/weightless-dpmi-file_io.ads b/weightless/adainclude/weightless-dpmi-file_io.ads --- a/weightless/adainclude/weightless-dpmi-file_io.ads false +++ b/weightless/adainclude/weightless-dpmi-file_io.ads 3a4b390479d969364b2bcc6e25d84c49e4bb303e62df21ae1ac7130b98d12ad5aa70658a72b15d0bc45fa2a341f5be352f8d040ab9ecd32d9259855e217da166 @@ -0,0 +1,34 @@ +with System; + +package Weightless.DPMI.File_IO is + + subtype File_Handle is Unsigned_32; + + type File_Access is (READ_ACCESS, WRITE_ACCESS, READ_AND_WRITE_ACCESS); + + for File_Access use + (READ_ACCESS => 0, + WRITE_ACCESS => 1, + READ_AND_WRITE_ACCESS => 2); + + STANDARD_INPUT : constant File_Handle := 0; + STANDARD_OUTPUT : constant File_Handle := 1; + STANDARD_ERROR : constant File_Handle := 2; + STANDARD_AUX : constant File_Handle := 3; + STANDARD_PRINTER : constant File_Handle := 4; + + function Open_File (File : out File_Handle; + Mode : in File_Access; + Name : in System.Address) return DOS_Error; + + function Read_File (File : in File_Handle; + Buffer_Address : in System.Address; + Bytes_to_Read : in Natural; + Bytes_Read : out Natural) return DOS_Error; + + function Write_File(File : in File_Handle; + Buffer_Address : in System.Address; + Bytes_to_Write : in Natural; + Bytes_Written : out Natural) return DOS_Error; + +end Weightless.DPMI.File_IO; diff -uNr a/weightless/adainclude/weightless-dpmi-process_control.adb b/weightless/adainclude/weightless-dpmi-process_control.adb --- a/weightless/adainclude/weightless-dpmi-process_control.adb false +++ b/weightless/adainclude/weightless-dpmi-process_control.adb 29d9f39c426bda0c49a460bfc6dfa1f0cef008c196cf98125c3fa2d722c3bbf9658f19a2f5506ca19170d18571d190e19625feb470fdaa3d3b46e8b60885623a @@ -0,0 +1,30 @@ +with System.Machine_Code; use System.Machine_Code; +with Weightless.DPMI.System_Calls; use Weightless.DPMI.System_Calls; + +package body Weightless.DPMI.Process_Control is + + procedure Terminate_Program(Return_Code : in Return_Code_Type) is + begin + Asm("int $0x21", + Inputs => (Unsigned_16'Asm_Input("a", + SYSCALL_EXIT or + Unsigned_16(Return_Code))), + Volatile => True); + + raise Program_Error; + end Terminate_Program; + + procedure Terminate_and_Stay_Resident(Return_Code : in Return_Code_Type) + is + begin + Asm("int $0x21", + Inputs => (Unsigned_16'Asm_Input("a", + SYSCALL_KEEP_PROCESS or + Unsigned_16(Return_Code)), + Unsigned_16'Asm_Input("d", 0)), + Volatile => True); + + raise Program_Error; + end Terminate_and_Stay_Resident; + +end Weightless.DPMI.Process_Control; diff -uNr a/weightless/adainclude/weightless-dpmi-process_control.ads b/weightless/adainclude/weightless-dpmi-process_control.ads --- a/weightless/adainclude/weightless-dpmi-process_control.ads false +++ b/weightless/adainclude/weightless-dpmi-process_control.ads d2b4a30302d6ff8a5f50660dfa16bbec1e9cc5eaff114a008b63b3a627b8e765f4382a4756d25daeec8c26c06b30beb8c68062e8daac33bca85fac1989810778 @@ -0,0 +1,16 @@ +package Weightless.DPMI.Process_Control is + + subtype Return_Code_Type is Unsigned_8; + + procedure Terminate_Program (Return_Code : in Return_Code_Type) + with No_Return; + + procedure Terminate_and_Stay_Resident(Return_Code : in Return_Code_Type) + with No_Return; + +private + + pragma Inline_Always(Terminate_Program); + pragma Inline_Always(Terminate_and_Stay_Resident); + +end Weightless.DPMI.Process_Control; diff -uNr a/weightless/adainclude/weightless-dpmi-system_calls.ads b/weightless/adainclude/weightless-dpmi-system_calls.ads --- a/weightless/adainclude/weightless-dpmi-system_calls.ads false +++ b/weightless/adainclude/weightless-dpmi-system_calls.ads f01643c96b0b89c2dfaf2a1c8cc63a55e3c6e24e59bb3e421e7c68788ffbceb6bcc7904042334a52e03143eef4a170779fc41dabd400769d2191c2e9e68ae66a @@ -0,0 +1,25 @@ +package Weightless.DPMI.System_Calls is + + SYSCALL_STD_CON_OUTPUT : constant := 16#0200#; + + SYSCALL_GET_DATE : constant := 16#2a00#; + SYSCALL_SET_DATE : constant := 16#2b00#; + SYSCALL_GET_TIME : constant := 16#2c00#; + SYSCALL_SET_TIME : constant := 16#2d00#; + + SYSCALL_KEEP_PROCESS : constant := 16#3100#; + + SYSCALL_CREAT : constant := 16#3c00#; + SYSCALL_OPEN : constant := 16#3d00#; + SYSCALL_CLOSE : constant := 16#3e00#; + SYSCALL_READ : constant := 16#3f00#; + SYSCALL_WRITE : constant := 16#4000#; + + SYSCALL_EXIT : constant := 16#4c00#; + + SYSCALL_GET_CURRENT_PDB : constant := 16#5100#; + + SYSCALL_GET_PROTECTED_MODE_INTERRUPT_VECTOR : constant := 16#0204#; + SYSCALL_SET_PROTECTED_MODE_INTERRUPT_VECTOR : constant := 16#0205#; + +end Weightless.DPMI.System_Calls; diff -uNr a/weightless/adainclude/weightless-dpmi.ads b/weightless/adainclude/weightless-dpmi.ads --- a/weightless/adainclude/weightless-dpmi.ads false +++ b/weightless/adainclude/weightless-dpmi.ads 89ed2579e52c6121149344c9659bd7cde4b2c6ada03646444a0dcf9711dedb1da5c84fb31b7e38835e19e281fcc6bee223820f7fcd1dff63fb3ef1ea159180be @@ -0,0 +1,83 @@ +with Interfaces; use Interfaces; + +package Weightless.DPMI is + + type DOS_Error is + (NO_ERROR_OCCURED, ERROR_INVALID_FUNCTION, ERROR_FILE_NOT_FOUND, + ERROR_PATH_NOT_FOUND, ERROR_TOO_MANY_OPEN_FILES, ERROR_ACCESS_DENIED, + ERROR_INVALID_HANDLE, ERROR_ARENA_TRASHED, ERROR_NOT_ENOUGH_MEMORY, + ERROR_INVALID_BLOCK, ERROR_BAD_ENVIRONMENT, ERROR_BAD_FORMAT, + ERROR_INVALID_ACCESS, ERROR_INVALID_DATA, ERROR_INVALID_DRIVE, + ERROR_CURRENT_DIRECTORY, ERROR_NOT_SAME_DEVICE, ERROR_NO_MORE_FILES); + + for DOS_Error use + (NO_ERROR_OCCURED => 0, + ERROR_INVALID_FUNCTION => 1, + ERROR_FILE_NOT_FOUND => 2, + ERROR_PATH_NOT_FOUND => 3, + ERROR_TOO_MANY_OPEN_FILES => 4, + ERROR_ACCESS_DENIED => 5, + ERROR_INVALID_HANDLE => 6, + ERROR_ARENA_TRASHED => 7, + ERROR_NOT_ENOUGH_MEMORY => 8, + ERROR_INVALID_BLOCK => 9, + ERROR_BAD_ENVIRONMENT => 10, + ERROR_BAD_FORMAT => 11, + ERROR_INVALID_ACCESS => 12, + ERROR_INVALID_DATA => 13, + ERROR_INVALID_DRIVE => 15, + ERROR_CURRENT_DIRECTORY => 16, + ERROR_NOT_SAME_DEVICE => 17, + ERROR_NO_MORE_FILES => 18); + + type DPMI_Error is + (DPMI_NO_ERR, DPMI_ERR_BAD_FN, DPMI_ERR_INVALID_STATE, + DPMI_ERR_SYS_INTEGRITY, DPMI_ERR_DEADLOCK, DPMI_ERR_REQ_CANCELLED, + DPMI_ERR_RSRC_UNAVAIL, DPMI_ERR_DESCRP_UNAVAIL, + DPMI_ERR_LINMEM_UNAVAIL, DPMI_ERR_PHYSMEM_UNAVAIL, + DPMI_ERR_BACKING_UNAVAIL, DPMI_ERR_CALLBACK_UNAVAIL, + DPMI_ERR_HANDLE_UNAVAIL, DPMI_ERR_LOCK_CNT, DPMI_ERR_RSRC_OWNED_EXCL, + DPMI_ERR_RSRC_OWNED_SHRD, DPMI_ERR_INVALID_VALUE, + DPMI_ERR_INVALID_SELECTOR, DPMI_ERR_INVALID_HANDLE, + DPMI_ERR_INVALID_CALLBACK, DPMI_ERR_INVALID_LINADDR, + DPMI_ERR_INVALID_REQUEST); + + for DPMI_Error use + (DPMI_NO_ERR => 16#0000#, + DPMI_ERR_BAD_FN => 16#8001#, + DPMI_ERR_INVALID_STATE => 16#8002#, + DPMI_ERR_SYS_INTEGRITY => 16#8003#, + DPMI_ERR_DEADLOCK => 16#8004#, + DPMI_ERR_REQ_CANCELLED => 16#8005#, + DPMI_ERR_RSRC_UNAVAIL => 16#8010#, + DPMI_ERR_DESCRP_UNAVAIL => 16#8011#, + DPMI_ERR_LINMEM_UNAVAIL => 16#8012#, + DPMI_ERR_PHYSMEM_UNAVAIL => 16#8013#, + DPMI_ERR_BACKING_UNAVAIL => 16#8014#, + DPMI_ERR_CALLBACK_UNAVAIL => 16#8015#, + DPMI_ERR_HANDLE_UNAVAIL => 16#8016#, + DPMI_ERR_LOCK_CNT => 16#8017#, + DPMI_ERR_RSRC_OWNED_EXCL => 16#8018#, + DPMI_ERR_RSRC_OWNED_SHRD => 16#8019#, + DPMI_ERR_INVALID_VALUE => 16#8021#, + DPMI_ERR_INVALID_SELECTOR => 16#8022#, + DPMI_ERR_INVALID_HANDLE => 16#8023#, + DPMI_ERR_INVALID_CALLBACK => 16#8024#, + DPMI_ERR_INVALID_LINADDR => 16#8025#, + DPMI_ERR_INVALID_REQUEST => 16#8026#); + + type Program_Segment_Prefix is record + Environment_Segment : Unsigned_16; + Command_Tail_Length : Integer range 0 .. 127; + Command_Tail : String(1 .. 127); + end record; + + for Program_Segment_Prefix use record + Environment_Segment at 16#2c# range 0 .. 2 * 8 - 1; + Command_Tail_Length at 16#80# range 0 .. 1 * 8 - 1; + Command_Tail at 16#81# range 0 .. 127 * 8 - 1; + end record; + + for Program_Segment_Prefix'Alignment use 1; + +end Weightless.DPMI; diff -uNr a/weightless/adainclude/weightless.ads b/weightless/adainclude/weightless.ads --- a/weightless/adainclude/weightless.ads false +++ b/weightless/adainclude/weightless.ads dbcc040794c4e6de3b5c27ea780548465bb91452fdf966f96113826bd384bc6354a7e15105e7ec92c578d43d8a80294f1af785e48c2b9e83414a039dd9e18fac @@ -0,0 +1,3 @@ +package Weightless is + pragma Pure; +end Weightless; diff -uNr a/weightless/adalib/README b/weightless/adalib/README --- a/weightless/adalib/README false +++ b/weightless/adalib/README 5fdbae897eb301a711bf95707f329517db540e34c182a5beec96e93d5d0d856cec2ed6b01c1191f865e8d1c45709a462c70c3005d4aa3676eb445d1479edf2e5 @@ -0,0 +1 @@ +Placeholder. diff -uNr a/weightless/obj/README b/weightless/obj/README --- a/weightless/obj/README false +++ b/weightless/obj/README 5fdbae897eb301a711bf95707f329517db540e34c182a5beec96e93d5d0d856cec2ed6b01c1191f865e8d1c45709a462c70c3005d4aa3676eb445d1479edf2e5 @@ -0,0 +1 @@ +Placeholder. diff -uNr a/weightless/restrict.adc b/weightless/restrict.adc --- a/weightless/restrict.adc false +++ b/weightless/restrict.adc 17ef5ed82ca01a702027a7d8c9b7dbc15ac454ef533decea347cf8953146e2ea6b0bb2e1f1c39d46e033b9104edad274a88f8528fe54966a968ecff2ceb1ad6f @@ -0,0 +1,65 @@ +pragma Restrictions(Immediate_Reclamation); +pragma Restrictions(Max_Asynchronous_Select_Nesting => 0); +pragma Restrictions(Max_Protected_Entries => 0); +pragma Restrictions(Max_Select_Alternatives => 0); +pragma Restrictions(Max_Task_Entries => 0); +pragma Restrictions(Max_Tasks => 0); +pragma Restrictions(No_Abort_Statements); +pragma Restrictions(No_Access_Parameter_Allocators); +pragma Restrictions(No_Allocators); +pragma Restrictions(No_Asynchronous_Control); +pragma Restrictions(No_Calendar); +pragma Restrictions(No_Coextensions); +pragma Restrictions(No_Default_Stream_Attributes); +pragma Restrictions(No_Delay); +pragma Restrictions(No_Dispatch); +pragma Restrictions(No_Dispatching_Calls); +pragma Restrictions(No_Dynamic_Attachment); +pragma Restrictions(No_Dynamic_Priorities); +pragma Restrictions(No_Entry_Calls_In_Elaboration_Code); +pragma Restrictions(No_Entry_Queue); +pragma Restrictions(No_Enumeration_Maps); +pragma Restrictions(No_Exception_Propagation); +pragma Restrictions(No_Exception_Registration); +pragma Restrictions(No_Finalization); +--pragma Restrictions(No_Fixed_Io); +pragma Restrictions(No_Implementation_Aspect_Specifications); +--pragma Restrictions(No_Implementation_Units); +pragma Restrictions(No_Implicit_Conditionals); +pragma Restrictions(No_Implicit_Dynamic_Code); +pragma Restrictions(No_Implicit_Heap_Allocations); +--pragma Restrictions(No_Implicit_Protected_Object_Allocations); +--pragma Restrictions(No_Implicit_Task_Allocations); +pragma Restrictions(No_Initialize_Scalars); +pragma Restrictions(No_Local_Protected_Objects); +pragma Restrictions(No_Local_Timing_Events); +--pragma Restrictions(No_Multiple_Elaboration); +pragma Restrictions(No_Nested_Finalization); +pragma Restrictions(No_Protected_Type_Allocators); +pragma Restrictions(No_Protected_Types); +pragma Restrictions(No_Relative_Delay); +pragma Restrictions(No_Requeue_Statements); +pragma Restrictions(No_Secondary_Stack); +pragma Restrictions(No_Select_Statements); +pragma Restrictions(No_Specific_Termination_Handlers); +pragma Restrictions(No_Standard_Allocators_After_Elaboration); +pragma Restrictions(No_Stream_Optimizations); +pragma Restrictions(No_Streams); +pragma Restrictions(No_Task_Allocators); +--pragma Restrictions(No_Task_At_Interrupt_Priority); +pragma Restrictions(No_Task_Attributes_Package); +pragma Restrictions(No_Task_Hierarchy); +pragma Restrictions(No_Tasking); +pragma Restrictions(No_Task_Termination); +pragma Restrictions(No_Terminate_Alternatives); +pragma Restrictions(No_Unchecked_Access); +pragma Restrictions(No_Unchecked_Deallocation); +pragma Restrictions(No_Wide_Characters); +--pragma Restrictions(Pure_Barriers); +pragma Restrictions(Simple_Barriers); +pragma Restrictions(Static_Priorities); +pragma Restrictions(Static_Storage_Size); +pragma Validity_Checks(ALL_CHECKS); +pragma Restrictions (No_Enumeration_Maps); +--pragma Restrictions(No_Implicit_Aliasing); +--pragma Restrictions (No_Exceptions); diff -uNr a/weightless/runtime.xml b/weightless/runtime.xml --- a/weightless/runtime.xml false +++ b/weightless/runtime.xml f620d4bfd5e7ed415d0ec22b818d328e500347ef0a3e1ee12439d2dc586b71aa735099707e4d1158270afef3f111f836dfbcda38c9859f9928243982384c6cf9 @@ -0,0 +1,21 @@ + + + + + + package Linker is + for Required_Switches use Linker'Required_Switches & + ("${RUNTIME_DIR(ada)}/adalib/libgnat.a") & + ("-nostdlib", "-nodefaultlibs", "-e_start"); + + for Required_Switches use Linker'Required_Switches & + ("${RUNTIME_DIR(ada)}/adalib/start.o"); + end Linker; + + package Binder is + for Required_Switches ("Ada") use Binder'Required_Switches ("Ada") & + ("-nostdlib", "-Mrun"); + end Binder; + + + diff -uNr a/weightless/weightless.gpr b/weightless/weightless.gpr --- a/weightless/weightless.gpr false +++ b/weightless/weightless.gpr 6fa2803a8bb40383396e29be004266defc8eef06a31ac0b820d08d69cf2af36fe14006fea2ee7c36d1f5f40ed065ee212742933278c5fdca251c590e88141cf6 @@ -0,0 +1,31 @@ +library project Weightless is + + for Languages use ("Ada"); + + for Source_Dirs use ("adainclude"); + for Object_Dir use "obj"; + for Library_Kind use "static"; + for Library_Name use "gnat"; + for Library_Dir use "adalib"; + + package Builder is + for Default_Switches ("Ada") use ("-x", "-gnatg", "-gnatyN", + "-gnatec=" & + Weightless'Project_Dir & + "restrict.adc"); + end Builder; + + package Compiler is + for Default_Switches ("Ada") use ("-O2", "-ffunction-sections", + "-fdata-sections", "-mno-stack-arg-probe"); + end Compiler; + + package Install is + for Sources_Subdir use "adainclude"; + for Ali_Subdir use "adalib"; + for Lib_Subdir use "adalib"; + for Required_Artifacts (".") use ("runtime.xml"); + for Install_Project use "false"; + end Install; + +end Weightless;