├── .gitignore ├── COPYING ├── Makefile ├── README.md ├── ats-anairiats-bignums.patch ├── ats_basics.h ├── ats_config.h ├── ats_exception.h ├── ats_memory.h ├── ats_types.h ├── bitflags.dats ├── bitflags.sats ├── boot.dats ├── bounded_strings.dats ├── bounded_strings.sats ├── enablable.dats ├── enablable.sats ├── gdt.dats ├── gdt.sats ├── gen_integer.lua ├── interrupts.dats ├── interrupts.sats ├── isr.S ├── kernel.ld ├── multiboot.sats ├── portio.dats ├── portio.sats ├── prelude ├── CATS │ ├── array.cats │ ├── basics.cats │ ├── bool.cats │ ├── byte.cats │ ├── char.cats │ ├── float.cats │ ├── integer.cats │ ├── integer_fixed.cats │ ├── integer_ptr.cats │ ├── lazy.cats │ ├── lazy_vt.cats │ ├── list.cats │ ├── matrix.cats │ ├── option.cats │ ├── pointer.cats │ ├── printf.cats │ ├── reference.cats │ ├── sizetype.cats │ └── string.cats ├── DATS │ ├── arith.dats │ └── integer.dats ├── SATS │ ├── arith.sats │ ├── array.sats │ ├── array0.sats │ ├── bool.sats │ ├── byte.sats │ ├── char.sats │ ├── dlist_vt.sats │ ├── extern.sats │ ├── filebas.sats │ ├── float.sats │ ├── integer_fixed.sats │ ├── integer_ptr.sats │ ├── lazy.sats │ ├── lazy_vt.sats │ ├── list.sats │ ├── list0.sats │ ├── list_vt.sats │ ├── matrix.sats │ ├── matrix0.sats │ ├── memory.sats │ ├── option.sats │ ├── option0.sats │ ├── option_vt.sats │ ├── pointer.sats │ ├── printf.sats │ ├── ptrarr.sats │ ├── reference.sats │ ├── sizetype.sats │ ├── string.sats │ └── vsubrw.sats ├── basics_dyn.sats ├── basics_sta.sats ├── fixity.ats ├── limits.sats ├── macrodef.sats ├── params.hats └── sortdef.sats ├── serial.dats ├── serial.sats ├── start.S ├── streams.dats ├── streams.sats ├── trace.dats ├── trace.sats ├── vga-text.dats └── vga-text.sats /.gitignore: -------------------------------------------------------------------------------- 1 | *_dats.c 2 | *_sats.c 3 | *.o 4 | kernel 5 | syms 6 | .*.swp 7 | .depends.mak 8 | prelude/SATS/integer.sats 9 | -------------------------------------------------------------------------------- /COPYING: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | 635 | Copyright (C) 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | Copyright (C) 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . 675 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | ATSHOME := $(CURDIR) 2 | ATSHOMERELOC ?= 3 | ATSOPT ?= ATSHOME=$(ATSHOME) ATSHOMERELOC=$(ATSHOMERELOC) compiler/bin/atsopt 4 | CC ?= gcc 5 | CFLAGS ?= -std=c99 -Wall -Wextra -Wno-unused -march=i386 \ 6 | -Os -m32 -nostdlib -fno-stack-protector \ 7 | -ffunction-sections -fdata-sections -fomit-frame-pointer -g 8 | LDFLAGS ?= -m32 -nostdlib -Wl,--build-id=none 9 | V ?= 0 # Verbosity 10 | 11 | SOURCES = prelude/limits.sats prelude/DATS/array.dats \ 12 | portio.sats portio.dats \ 13 | boot.dats vga-text.sats vga-text.dats \ 14 | enablable.sats enablable.dats \ 15 | streams.sats streams.dats \ 16 | bounded_strings.sats bounded_strings.dats \ 17 | bitflags.sats bitflags.dats multiboot.sats \ 18 | serial.sats serial.dats trace.sats trace.dats \ 19 | gdt.sats gdt.dats interrupts.sats interrupts.dats 20 | 21 | PF_SOURCES = prelude/DATS/integer.dats prelude/DATS/arith.dats 22 | 23 | SOURCES := $(SOURCES) $(PF_SOURCES) 24 | 25 | ifeq ($(strip $(V)),0) 26 | ECHO = @echo 27 | GENSTR = " GEN $<" 28 | ATSSTR = " ATS $<" 29 | CCSTR = " CC $<" 30 | LDSTR = " LD $@" 31 | NMSTR = " NM $<" 32 | X = @ 33 | else 34 | ECHO = @\# 35 | X = 36 | endif 37 | 38 | as_sources := start.S isr.S 39 | sats_sources := $(filter %.sats,$(SOURCES)) 40 | dats_sources := $(filter %.dats,$(SOURCES)) 41 | sats_objects := $(patsubst %.sats,%_sats.o,$(sats_sources)) 42 | dats_objects := $(patsubst %.dats,%_dats.o,$(dats_sources)) 43 | objects := $(sats_objects) $(dats_objects) 44 | prelude_sources := $(wildcard prelude/SATS/*.sats) prelude/SATS/integer.sats 45 | 46 | clean_files := test $(objects) $(objects:.o=.c) 47 | 48 | .PHONY: all always compiler 49 | 50 | all: kernel syms 51 | 52 | # Link twice: once without --gc-sections to check elaborations 53 | # then with --gc-sections to remove unused sections. 54 | kernel: $(objects) $(as_sources) kernel.ld 55 | $(ECHO) $(LDSTR) 56 | $(X)$(CC) $(LDFLAGS) -Wl,-T,kernel.ld -o $@ $(as_sources) $(objects) 57 | $(X)$(CC) $(LDFLAGS) -Wl,--gc-sections,-T,kernel.ld -o $@ $(as_sources) $(objects) 58 | 59 | syms: kernel 60 | $(ECHO) $(NMSTR) 61 | nm kernel > syms 62 | 63 | # Do all ATS compiling before C compiling. It looks nicer! :-D 64 | $(sats_objects) $(dats_objects): %.o: %.c | $(sats_objects:.o=.c) $(dats_objects:.o=.c) 65 | $(ECHO) $(CCSTR) 66 | $(X)$(CC) $(CFLAGS) -I. -c -o $@ $< 67 | 68 | $(dats_objects:.o=.c): %_dats.c: %.dats $(prelude_sources) 69 | $(ECHO) $(ATSSTR) 70 | $(X)$(ATSOPT) --output $@ --dynamic $< || { $(RM) $@ ; false ; } 71 | 72 | $(sats_objects:.o=.c): %_sats.c: %.sats $(prelude_sources) 73 | $(ECHO) $(ATSSTR) 74 | $(X)$(ATSOPT) --gline --output $@ --static $< || { $(RM) $@ ; false ; } 75 | 76 | prelude/SATS/integer.sats: gen_integer.lua 77 | $(ECHO) $(GENSTR) 78 | $(X)lua gen_integer.lua > $@ || { $(RM) $@ ; false ; } 79 | 80 | .PHONY: depend 81 | 82 | depend: prelude/SATS/integer.sats 83 | $(ECHO) " Analysing dependencies..." 84 | $(X)$(ATSOPT) -dep1 -s $(sats_sources) -d $(dats_sources) \ 85 | | sed -r 's/^ *([^:]*)\.o *:/\1.c :/' > .depends.mak 86 | 87 | .PHONY: clean 88 | 89 | clean: 90 | $(ECHO) " Cleaning..." 91 | $(ECHO) " "$(clean_files) 92 | $(X)$(RM) $(clean_files) 93 | 94 | -include .depends.mak 95 | 96 | # Check out and build a patched version of the ATS compiler. 97 | compiler: 98 | $(X)[ -e "compiler/" ] || { svn checkout "https://ats-lang.svn.sourceforge.net/svnroot/ats-lang/trunk" "compiler" && patch --directory="compiler/" -Np1 <"ats-anairiats-bignums.patch" ; } 99 | $(X)[ -e "compiler/bootstrap0" ] || svn checkout "https://ats-lang.svn.sourceforge.net/svnroot/ats-lang/bootstrap/anairiats" "compiler/bootstrap0" 100 | $(X)[ -e "compiler/configure" ] || { cd "compiler/" && { aclocal ; automake --add-missing ; autoconf ; } ; } 101 | $(X)[ -e "compiler/config.h" ] || { cd "compiler/" && ./configure ; } 102 | $(X)[ -e "compiler/bin/atsopt" ] || { cd "compiler/" && $(MAKE) atsopt0-anairiats bootstrapping atsopt1 ; } 103 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | AOS - Applied Operating System 2 | ============================== 3 | 4 | Aims 5 | ---- 6 | 7 | To be written in ATS (http://www.ats-lang.org/), which is a programming 8 | language that has a very flexible type system, supporting dependent and 9 | linear types. The language compiles straightforwardly to C, with no 10 | garbage collection (by default), making it very useful for low-level 11 | programming. ATS's type system can be used to prove at compile-time, among many 12 | other properties, the absence of memory leaks, double frees, dangling 13 | pointers, uninitialised value or pointer use and integer overflow. 14 | 15 | Compiling 16 | --------- 17 | 18 | AOS defines operators on integers such that they cannot be called if the 19 | operation would overflow. This requires ATS's constraint solver to 20 | handle large integers. The current release of ATS, "Anairiats", is 21 | unable to handle such large numbers in the constraint solver 22 | (ironically, integers in the constraint solver overflow), so included with AOS 23 | is a patch to use bignums in the constraint solver. 24 | 25 | The ATS compiler is written in ATS, but because it translates to C, the 26 | compiler can be boot-strapped by compiling intermediate C sources. 27 | AOS's makefile contains a rule to check out (from subversion) and build a copy 28 | of the ATS compiler automatically. Run: 29 | 30 | make compiler 31 | 32 | in the AOS directory. Then you can compile AOS with: 33 | 34 | make depend 35 | make 36 | 37 | Use `make V=1` to echo commands. 38 | 39 | Features 40 | -------- 41 | 42 | * 486SX-compatible. There's no reason it shouldn't run on i386 too, but it's 43 | not tested. 44 | * It prints greetings to the serial port! 45 | 46 | Booting 47 | ------- 48 | 49 | AOS compiles to a 50 | [multiboot] (http://www.gnu.org/software/grub/manual/multiboot/multiboot.html) 51 | ELF file called, believe it or not, `kernel`, linked at `0x00100000`. A small 52 | amount of code in `start.S` identity-maps the first four megabytes of physical 53 | memory, turns on paging and jumps to ATS code, which can be linked at virtual 54 | addresses different to the physical addresses (but isn't now). 55 | 56 | Use a multiboot-compliant boot-loader such as 57 | [GNU GRUB] (http://www.gnu.org/software/grub/) to boot AOS, or run it in QEMU with 58 | 59 | qemu -kernel kernel 60 | -------------------------------------------------------------------------------- /ats-anairiats-bignums.patch: -------------------------------------------------------------------------------- 1 | diff --git a/src/ats_solver_fm.cats b/src/ats_solver_fm.cats 2 | index b1f71bb..d264314 100644 3 | --- a/src/ats_solver_fm.cats 4 | +++ b/src/ats_solver_fm.cats 5 | @@ -48,16 +48,26 @@ 6 | 7 | /* ****** ****** */ 8 | 9 | +typedef ats_mpz_ptr_type i0nt; 10 | + 11 | +/* ****** ****** */ 12 | + 13 | ATSinline() 14 | -ats_int_type 15 | +i0nt 16 | atsopt_solver_fm_i0nt_of_int 17 | - (ats_int_type i) { return (i) ; } 18 | + (ats_int_type i) 19 | +{ 20 | + ats_ptr_type p = atspre_ptr_alloc_tsz (sizeof (ats_mpz_viewt0ype)); 21 | + atslib_mpz_init_set_int (p, i); 22 | + return p; 23 | +} 24 | // end of [atsopt_solver_fm_i0nt_of_int] 25 | 26 | ATSinline() 27 | -ats_int_type 28 | +i0nt 29 | atsopt_solver_fm_i0nt_of_intinf 30 | - (ats_mpz_ptr_type i) { return atsopt_get_int (i) ; } 31 | + (ats_mpz_ptr_type i) 32 | +{ return i ; } 33 | // end of [atsopt_solver_fm_i0nt_of_intinf] 34 | 35 | /* ****** ****** */ 36 | @@ -65,48 +75,48 @@ atsopt_solver_fm_i0nt_of_intinf 37 | ATSinline() 38 | ats_bool_type 39 | atsopt_solver_fm_gt_i0nt_int 40 | - (ats_int_type i0, ats_int_type i) { 41 | - return (i0 > i ? ats_true_bool : ats_false_bool) ; 42 | + (i0nt i0, ats_int_type i) { 43 | + return atsopt_gt_intinf_int (i0, i) ; 44 | } // end of [atsopt_solver_fm_gt_i0nt_int] 45 | 46 | ATSinline() 47 | ats_bool_type 48 | atsopt_solver_fm_gte_i0nt_int ( 49 | - ats_int_type i0, ats_int_type i 50 | + i0nt i0, ats_int_type i 51 | ) { 52 | - return (i0 >= i ? ats_true_bool : ats_false_bool) ; 53 | + return atsopt_gte_intinf_int (i0, i) ; 54 | } // end of [atsopt_solver_fm_gte_i0nt_int] 55 | 56 | ATSinline() 57 | ats_bool_type 58 | atsopt_solver_fm_lt_i0nt_int ( 59 | - ats_int_type i0, ats_int_type i 60 | + i0nt i0, ats_int_type i 61 | ) { 62 | - return (i0 < i ? ats_true_bool : ats_false_bool) ; 63 | + return atsopt_lt_intinf_int (i0, i) ; 64 | } // end of [atsopt_solver_fm_lt_i0nt_int] 65 | 66 | ATSinline() 67 | ats_bool_type 68 | atsopt_solver_fm_lte_i0nt_int ( 69 | - ats_int_type i0, ats_int_type i 70 | + i0nt i0, ats_int_type i 71 | ) { 72 | - return (i0 <= i ? ats_true_bool : ats_false_bool) ; 73 | + return atsopt_lte_intinf_int (i0, i) ; 74 | } // end of [atsopt_solver_fm_lte_i0nt_int] 75 | 76 | ATSinline() 77 | ats_bool_type 78 | atsopt_solver_fm_eq_i0nt_int ( 79 | - ats_int_type i0, ats_int_type i 80 | + i0nt i0, ats_int_type i 81 | ) { 82 | - return (i0 == i ? ats_true_bool : ats_false_bool) ; 83 | + return atsopt_eq_intinf_int (i0, i) ; 84 | } // end of [atsopt_solver_fm_eq_i0nt_int] 85 | 86 | ATSinline() 87 | ats_bool_type 88 | atsopt_solver_fm_neq_i0nt_int ( 89 | - ats_int_type i0, ats_int_type i 90 | + i0nt i0, ats_int_type i 91 | ) { 92 | - return (i0 != i ? ats_true_bool : ats_false_bool) ; 93 | + return atsopt_neq_intinf_int (i0, i) ; 94 | } // end of [atsopt_solver_fm_neq_i0nt_int] 95 | 96 | // 97 | @@ -114,93 +124,114 @@ atsopt_solver_fm_neq_i0nt_int ( 98 | ATSinline() 99 | ats_bool_type 100 | atsopt_solver_fm_gt_i0nt_i0nt ( 101 | - ats_int_type i1, ats_int_type i2 102 | + i0nt i1, i0nt i2 103 | ) { 104 | - return (i1 > i2 ? ats_true_bool : ats_false_bool) ; 105 | + return atsopt_gt_intinf_intinf (i1, i2) ; 106 | } // end of [atsopt_solver_fm_gt_i0nt_i0nt] 107 | 108 | ATSinline() 109 | ats_bool_type 110 | atsopt_solver_fm_lt_i0nt_i0nt ( 111 | - ats_int_type i1, ats_int_type i2 112 | + i0nt i1, i0nt i2 113 | ) { 114 | - return (i1 < i2 ? ats_true_bool : ats_false_bool) ; 115 | + return atsopt_lt_intinf_intinf (i1, i2) ; 116 | } // end of [atsopt_solver_fm_lt_i0nt_i0nt] 117 | 118 | // 119 | 120 | ATSinline() 121 | -ats_int_type 122 | +i0nt 123 | atsopt_solver_fm_neg_i0nt 124 | - (ats_int_type i) { return (-i) ; } 125 | + (i0nt i) { return atsopt_neg_intinf (i) ; } 126 | // end of [atsopt_solver_fm_neg_i0nt] 127 | 128 | ATSinline() 129 | -ats_int_type 130 | +i0nt 131 | atsopt_solver_fm_add_i0nt_i0nt ( 132 | - ats_int_type i1, ats_int_type i2 133 | + i0nt i1, i0nt i2 134 | ) { 135 | - return (i1 + i2) ; 136 | + return atsopt_add_intinf_intinf (i1, i2) ; 137 | } // end of [atsopt_solver_fm_add_i0nt_i0nt] 138 | 139 | ATSinline() 140 | -ats_int_type 141 | +i0nt 142 | atsopt_solver_fm_sub_i0nt_i0nt ( 143 | - ats_int_type i1, ats_int_type i2 144 | + i0nt i1, i0nt i2 145 | ) { 146 | - return (i1 - i2) ; 147 | + return atsopt_sub_intinf_intinf (i1, i2) ; 148 | } // end of [atsopt_solver_fm_sub_i0nt_i0nt] 149 | 150 | ATSinline() 151 | -ats_int_type 152 | +i0nt 153 | atsopt_solver_fm_mul_i0nt_i0nt ( 154 | - ats_int_type i1, ats_int_type i2 155 | + i0nt i1, i0nt i2 156 | ) { 157 | - return (i1 * i2) ; 158 | + return atsopt_mul_intinf_intinf (i1, i2) ; 159 | } // end of [atsopt_solver_fm_mul_i0nt_i0nt] 160 | 161 | ATSinline() 162 | -ats_int_type 163 | +i0nt 164 | atsopt_solver_fm_div_i0nt_i0nt ( 165 | - ats_int_type i1, ats_int_type i2 166 | + i0nt i1, i0nt i2 167 | ) { 168 | - return (i1 / i2) ; 169 | + mpz_ptr ans = ATS_MALLOC (sizeof(ats_mpz_viewt0ype)) ; 170 | + mpz_init (ans) ; 171 | + mpz_tdiv_q (ans, i1, i2) ; 172 | + return ans ; 173 | } // end of [atsopt_solver_fm_div_i0nt_i0nt] 174 | 175 | // 176 | 177 | ATSinline() 178 | -ats_int_type 179 | +i0nt 180 | atsopt_solver_fm_succ_i0nt 181 | - (ats_int_type i) { return (i + 1) ; } 182 | + (i0nt i) { 183 | + mpz_ptr ans = ATS_MALLOC (sizeof(ats_mpz_viewt0ype)) ; 184 | + mpz_init (ans) ; 185 | + mpz_add_ui (ans, i, 1) ; 186 | + return ans ; 187 | +} 188 | // end of [atsopt_solver_fm_succ_i0nt] 189 | 190 | ATSinline() 191 | -ats_int_type 192 | +i0nt 193 | atsopt_solver_fm_pred_i0nt 194 | - (ats_int_type i) { return (i - 1) ; } 195 | + (i0nt i) { 196 | + mpz_ptr ans = ATS_MALLOC (sizeof(ats_mpz_viewt0ype)) ; 197 | + mpz_init (ans) ; 198 | + mpz_sub_ui (ans, i, 1) ; 199 | + return ans ; 200 | +} 201 | // end of [atsopt_solver_fm_pred_i0nt] 202 | 203 | // 204 | 205 | ATSinline() 206 | -ats_int_type 207 | +i0nt 208 | atsopt_solver_fm_mod_i0nt_i0nt 209 | - (ats_int_type i1, ats_int_type i2) { 210 | - return (i1 % i2) ; 211 | + (i0nt i1, i0nt i2) { 212 | + mpz_ptr ans = ATS_MALLOC (sizeof(ats_mpz_viewt0ype)) ; 213 | + mpz_init (ans); 214 | + mpz_tdiv_r (ans, i1, i2) ; 215 | + return ans ; 216 | } // end of [atsopt_solver_fm_mod_i0nt_i0nt] 217 | 218 | ATSinline() 219 | -ats_int_type 220 | +i0nt 221 | atsopt_solver_fm_gcd_i0nt_i0nt ( 222 | - ats_int_type i1, ats_int_type i2 223 | + i0nt i1, i0nt i2 224 | ) { 225 | - int tmp ; 226 | - if (i1 < 0) i1 = -i1 ; 227 | - if (i2 < 0) i2 = -i2 ; 228 | - 229 | + if (atsopt_lt_intinf_int (i1, 0)) { 230 | + i1 = atsopt_neg_intinf (i1) ; 231 | + } 232 | + if (atsopt_lt_intinf_int (i2, 0)) { 233 | + i2 = atsopt_neg_intinf (i2) ; 234 | + } 235 | while (1) { 236 | - if (i2 == 0) return i1; tmp = i1 % i2 ; i1 = i2 ; i2 = tmp ; 237 | + if (atsopt_eq_intinf_int (i2, 0)) return i1; 238 | + i0nt tmp = atsopt_solver_fm_mod_i0nt_i0nt (i1, i2) ; 239 | + i1 = i2; 240 | + i2 = tmp; 241 | } 242 | return 0 ; /* deadcode */ 243 | } // end of [atsopt_solver_fm_gcd_i0nt_i0nt] 244 | @@ -210,8 +241,8 @@ atsopt_solver_fm_gcd_i0nt_i0nt ( 245 | ATSinline() 246 | ats_void_type 247 | atsopt_solver_fm_fprint_i0nt 248 | - (ats_ptr_type out, ats_int_type i) { 249 | - fprintf ((FILE *)out, "%i", i) ; return ; 250 | + (ats_ptr_type out, i0nt i) { 251 | + atslib_fprint_mpz (out, i) ; 252 | } // end of [atsopt_solver_fm_fprint_i0nt] 253 | 254 | /* ****** ****** */ 255 | @@ -234,10 +265,16 @@ ATSinline() 256 | ats_ptr_type 257 | atsopt_solver_fm_intvec_ptr_make 258 | (ats_int_type n) { 259 | - int *p ; 260 | - int nbytes = n * sizeof(ats_int_type) ; 261 | + i0nt zero = ATS_MALLOC (sizeof(ats_mpz_viewt0ype)) ; 262 | + mpz_init_set_si (zero, 0) ; 263 | + i0nt *p ; 264 | + int i ; 265 | + int nbytes = n * sizeof(i0nt) ; 266 | p = ATS_MALLOC (nbytes) ; 267 | - return memset (p, 0, nbytes) ; 268 | + for (i=0; iclosure_fun 129 | 130 | /* ****** ****** */ 131 | // 132 | // HX: handling cast functions 133 | // 134 | #define ats_castfn_mac(hit, vp) ((hit)vp) 135 | 136 | /* ****** ****** */ 137 | 138 | #define ats_field_getval(tyrec, ref, lab) (((tyrec*)(ref))->lab) 139 | #define ats_field_getptr(tyrec, ref, lab) (&((tyrec*)(ref))->lab) 140 | 141 | /* ****** ****** */ 142 | 143 | #define ats_cast_mac(ty, x) ((ty)(x)) 144 | #define ats_castptr_mac(ty, x) ((ty*)(x)) 145 | 146 | #define ats_selind_mac(x, ind) ((x)ind) 147 | #define ats_selbox_mac(x, lab) ((x)->lab) 148 | #define ats_select_mac(x, lab) ((x).lab) 149 | #define ats_selptr_mac(x, lab) ((x)->lab) 150 | #define ats_selsin_mac(x, lab) (x) 151 | 152 | #define ats_selptrset_mac(ty, x, lab, v) (((ty*)x)->lab = (v)) 153 | 154 | #define ats_caselind_mac(ty, x, ind) (((ty*)(x))ind) 155 | #define ats_caselptr_mac(ty, x, lab) (((ty*)(x))->lab) 156 | 157 | #define ats_varget_mac(ty, x) (x) 158 | #define ats_ptrget_mac(ty, x) (*(ty*)(x)) 159 | 160 | /* ****** ****** */ 161 | // 162 | // HX: handling for/while loops 163 | // 164 | #define ats_loop_beg_mac(init) while(ats_true_bool) { init: 165 | #define ats_loop_end_mac(init, fini) goto init ; fini: break ; } 166 | 167 | // 168 | // HX: handling while loop: deprecated!!! 169 | // 170 | #define ats_while_beg_mac(clab) while(ats_true_bool) { clab: 171 | #define ats_while_end_mac(blab, clab) goto clab ; blab: break ; } 172 | 173 | /* ****** ****** */ 174 | // 175 | // HX: for initializing a reference 176 | // 177 | #define ats_instr_move_ref_mac(tmp, hit, val) \ 178 | do { tmp = ATS_MALLOC (sizeof(hit)) ; *(hit*)tmp = val ; } while (0) 179 | 180 | /* ****** ****** */ 181 | // 182 | // HX: for proof checking at run-time 183 | // 184 | #define \ 185 | ats_proofcheck_beg_mac(dyncst) \ 186 | static int dyncst ## _flag = 0 ; \ 187 | do { \ 188 | if (dyncst ## _flag > 0) return ; \ 189 | if (dyncst ## _flag < 0) { \ 190 | fprintf (stderr, \ 191 | "exit(ATS): proof checking failure: [%s] is cyclically defined!\n", \ 192 | # dyncst \ 193 | ) ; \ 194 | exit (1) ; \ 195 | } \ 196 | dyncst ## _flag = -1 ; \ 197 | } while (0) ; 198 | /* end of [ats_proofcheck_beg_mac] */ 199 | 200 | #define \ 201 | ats_proofcheck_end_mac(dyncst) { dyncst ## _flag = 1 ; } 202 | 203 | /* ****** ****** */ 204 | 205 | /* 206 | ** HX: 207 | ** [mainats_prelude] is called in the function [main] 208 | ** it is implemented in [$ATSHOME/prelude/ats_main_prelude.dats] 209 | ** where it is given the name [main_prelude]. 210 | */ 211 | extern void mainats_prelude () ; 212 | 213 | /* ****** ****** */ 214 | 215 | /* 216 | ** HX: 217 | ** functions for handling match failures 218 | ** the implementation is given in [ats_prelude.c] 219 | */ 220 | extern void ats_caseof_failure_handle (const char *loc) ; 221 | extern void ats_funarg_match_failure_handle (const char *loc) ; 222 | 223 | /* ****** ****** */ 224 | 225 | #endif /* ATS_BASICS_H */ 226 | 227 | /* end of [ats_basics.h] */ 228 | -------------------------------------------------------------------------------- /ats_config.h: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/ats_config.h -------------------------------------------------------------------------------- /ats_exception.h: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/ats_exception.h -------------------------------------------------------------------------------- /ats_memory.h: -------------------------------------------------------------------------------- 1 | #define ATS_GC_MARKROOT(a,b) do { } while (0) 2 | #define ATS_ALLOCA2(n, sz) __builtin_alloca((n)*(sz)) 3 | -------------------------------------------------------------------------------- /ats_types.h: -------------------------------------------------------------------------------- 1 | #include "stdint.h" 2 | #include "stddef.h" /* for size_t */ 3 | typedef void ats_void_type; 4 | typedef int ats_int_type; 5 | typedef void *ptr; 6 | typedef void *ats_ptr_type; 7 | typedef void *ats_ref_type; 8 | typedef signed char schar; 9 | typedef unsigned char uchar; 10 | typedef unsigned short ushort; 11 | typedef unsigned int uint; 12 | typedef unsigned long ulong; 13 | typedef long long llong; 14 | typedef unsigned long long ullong; 15 | typedef size_t ats_size_type; 16 | -------------------------------------------------------------------------------- /bitflags.dats: -------------------------------------------------------------------------------- 1 | staload "bitflags.sats" 2 | 3 | extern prfun conjure_bit_is_set {x, n: int; b: bool} (): 4 | [bit_is_set (x, n) == b] void 5 | 6 | implement test_bit {x} {n} (x, n) = 7 | let 8 | prval pf_mask = SHL_make {1, n} () 9 | prval () = SHL_le (pf_mask, ,(pf_shl_const 1 (INT_BIT-1))) 10 | val mask = ushl (pf_mask | 1u, n) 11 | in 12 | if (x land mask) != 0u then 13 | let prval () = conjure_bit_is_set {x, n, true} () in true end 14 | else 15 | let prval () = conjure_bit_is_set {x, n, false} () in false end 16 | end 17 | -------------------------------------------------------------------------------- /bitflags.sats: -------------------------------------------------------------------------------- 1 | staload "prelude/limits.sats" 2 | 3 | // Encapsulate the property of a bit in an integer being set. 4 | 5 | stacst bit_is_set : (int, int) -> bool 6 | 7 | fun test_bit {x: Uint} {n: Nat | n < INT_BIT} 8 | (x: uint x, n: int n): 9 | bool (bit_is_set (x, n)) 10 | 11 | -------------------------------------------------------------------------------- /boot.dats: -------------------------------------------------------------------------------- 1 | staload "trace.sats" 2 | staload "portio.sats" 3 | staload GDT = "gdt.sats" 4 | staload INT = "interrupts.sats" 5 | staload "bitflags.sats" 6 | staload "multiboot.sats" 7 | staload BS = "bounded_strings.sats" 8 | staload "streams.sats" 9 | dynload "prelude/DATS/integer.dats" 10 | dynload "prelude/DATS/arith.dats" 11 | dynload "prelude/DATS/array.dats" 12 | dynload "bitflags.dats" 13 | dynload "vga-text.dats" 14 | dynload "portio.dats" 15 | dynload "serial.dats" 16 | dynload "trace.dats" 17 | dynload "enablable.dats" 18 | dynload "gdt.dats" 19 | dynload "interrupts.dats" 20 | dynload "bounded_strings.dats" 21 | dynload "streams.dats" 22 | 23 | extern fun ats_entry_point 24 | {l: agz} 25 | (pf_mb_info: !(mb_info @ l) | 26 | magic: uint32, mb_info: ptr l): void 27 | = "ats_entry_point" 28 | 29 | fn play_with_strings (): void = 30 | let 31 | var !s_buf with pf_s_buf = @[char][256] ('\0') 32 | var s = $BS.create (pf_s_buf | s_buf, 256) 33 | var c = $BS.stream (view@ s | &s) 34 | val () = put (HEX | c, 123) 35 | prval () = view@ s := $BS.unstream c 36 | val () = pf_s_buf := ($BS.destroy s).0 37 | in () end 38 | 39 | implement ats_entry_point (pf_mb_info | magic, mb_info) = 40 | let 41 | var i: [i: Int] int i 42 | extern castfn uint_of_ptr1 (p: [l: addr] ptr l):<> uint 43 | extern castfn uint_of_type {t:type} (x: !t):<> uint 44 | extern castfn uint_of_size1 (x: [x: int] size_t x):<> uint 45 | extern castfn string_of_uint (x: uint):<> string 46 | in 47 | // Give UART time to catch up: 48 | for (i := 0; i < 1000; i := i + 1) io_wait (); 49 | init_serial (1, 115200u); 50 | // init_vga (); 51 | trace "Hello, world!\n"; 52 | play_with_strings (); 53 | trace "mb size: 0x"; 54 | dump_uint (uint_of_size1 sizeof); 55 | trace "\nBoot magic: 0x"; 56 | dump_uint magic; 57 | trace "\nmb_info is at 0x"; 58 | dump_uint (uint_of_ptr1 mb_info); 59 | trace "\nBoot loader flags are 0x"; 60 | dump_uint mb_info->flags; 61 | trace "\nmem_lower: 0x"; 62 | dump_uint mb_info->mem_lower; 63 | trace "\nmem_upper: 0x"; 64 | dump_uint mb_info->mem_upper; 65 | trace "\ncmd_line: 0x"; 66 | dump_uint mb_info->cmd_line; 67 | trace " "; 68 | trace (string_of_uint (mb_info->cmd_line)); 69 | trace "\n"; 70 | if test_bit (mb_info->flags, MBI_BOOT_LOADER_NAME) then 71 | let 72 | prval () = opt_unsome mb_info->boot_loader_name 73 | val () = trace "Boot loader name is at 0x" 74 | val () = dump_uint (uint_of_type (mb_info->boot_loader_name)); 75 | val () = trace "\nBoot loader name: " 76 | val () = trace mb_info->boot_loader_name 77 | val () = trace "\n"; 78 | prval () = opt_some mb_info->boot_loader_name 79 | in end; 80 | $GDT.init (); 81 | $INT.init (); 82 | $INT.enable_interrupts_globally (); 83 | $INT.unmask_irq (0); 84 | while (true) (); 85 | traceloc "\nHalting.\n" 86 | end 87 | -------------------------------------------------------------------------------- /bounded_strings.dats: -------------------------------------------------------------------------------- 1 | staload "bounded_strings.sats" 2 | 3 | assume bstring (l: addr, sz: int, len: int) = 4 | [len < sz] 5 | @{ 6 | pf = @[char][sz] @ l, 7 | s = ptr l, 8 | len = int len, 9 | sz = int sz 10 | } 11 | 12 | (* 13 | implement create (s, pf, buf, sz) = 14 | s := @{ pf = pf, s = buf, len = 0, sz = sz } 15 | *) 16 | 17 | implement create (pf | buf, sz) = 18 | @{ pf=pf, s=buf, len=0, sz=sz } 19 | 20 | implement destroy (s) = 21 | (s.pf | ()) 22 | 23 | implement length (s) = s.len 24 | 25 | implement clear (s) = s.len := 0 26 | 27 | implement char_at (s, idx) = 28 | let 29 | prval pf = s.pf 30 | val ch = s.s->[idx] 31 | prval () = s.pf := pf 32 | in ch end 33 | 34 | implement set_char_at (s, idx, ch) = 35 | let 36 | prval pf = s.pf 37 | val () = s.s->[idx] := ch 38 | prval () = s.pf := pf 39 | in () end 40 | 41 | implement append_char (s, ch) = 42 | let 43 | prval pf = s.pf 44 | val () = s.s->[s.len] := ch 45 | prval () = s.pf := pf 46 | val () = s.len := s.len + 1 47 | in () end 48 | 49 | implement append_string {l, sz, len, len2} (s, s2, len2) = 50 | let var i: Int in 51 | for* {i: nat | i <= len2} .. (i: int i) => 52 | (i := 0; i < len2; i := i + 1) 53 | let prval pf = s.pf in 54 | s.s->[s.len + i] := s2[i]; 55 | let prval () = s.pf := pf in () end 56 | end; 57 | s.len := s.len + len2 58 | end 59 | 60 | implement append_bstring {l, sz, len, l2, sz2, len2} (s, s2) = 61 | let var i: Int in 62 | for* {i: nat | i <= len2} .. (i: int i) => 63 | (i := 0; i < s2.len; i := i + 1) 64 | let prval pf = s.pf in 65 | s.s->[s.len + i] := s2[i]; 66 | let prval () = s.pf := pf in () end 67 | end; 68 | s.len := s.len + s2.len 69 | end 70 | 71 | viewdef stream_v (l: addr, sz: int, p: addr) = 72 | [len: nat | len < sz] bstring (l, sz, len) @ p 73 | 74 | assume stream_vt (l: addr, sz: int, p: addr) = 75 | @{pf = stream_v (l, sz, p), p = ptr p} 76 | 77 | var funcs: {l: agz; sz: Nat; p: agz} 78 | $Streams.funcs (stream_vt (l, sz, p)) = 79 | @{ 80 | put_char = put_char 81 | } 82 | where { 83 | fn put_char {l: agz; sz: Nat; p: agz} 84 | (obj: !stream_vt (l, sz, p), ch: char):<> void = 85 | let prval pf = obj.pf: stream_v (l, sz, p) in 86 | if obj.p->len < obj.p->sz - 1 then 87 | append_char (!(obj.p), ch); 88 | let prval () = obj.pf := pf in () end 89 | end 90 | } 91 | 92 | val (pf_funcs | ()) = vbox_make_view_ptr (view@ funcs | &funcs) 93 | 94 | implement stream {p, l, sz, len} (pf | p) = 95 | @{ 96 | p = @{pf=pf, p=p}, 97 | pf_funcs = pf_funcs, 98 | //vbox_unsafe_copy 99 | // {$Streams.funcs (stream_vt (l, sz, p))} pf_funcs, 100 | funcs = &funcs 101 | } 102 | 103 | implement unstream {p, l, sz} (stream) = stream.p.pf 104 | -------------------------------------------------------------------------------- /bounded_strings.sats: -------------------------------------------------------------------------------- 1 | // Bounded-length strings: strings in fixed-length buffers. 2 | // Note that the buffer must be at least one byte long, for 3 | // the null terminator. 4 | 5 | staload "prelude/limits.sats" 6 | staload Streams = "streams.sats" 7 | 8 | absviewt@ype bstring (l: addr, sz: int, len: int) = @( ptr, int ) 9 | 10 | (* 11 | fun create {l: agz} {sz: Pos} 12 | (s: &bstring (l, sz, 0)? >> bstring (l, sz, 0), 13 | pf: (@[char][sz]) @ l, 14 | buf: ptr l, 15 | sz: int sz):<> void 16 | *) 17 | 18 | fun create {l: agz} {sz: Pos} 19 | (pf: @[char][sz] @ l | 20 | buf: ptr l, sz: int sz):<> 21 | bstring (l, sz, 0) 22 | 23 | fun destroy {l: agz} {sz: Nat} {len: int} 24 | (s: &bstring (l, sz, len) >> bstring (l, sz, len)?):<> 25 | (@[char][sz] @ l | void) 26 | 27 | fun length {l: agz; sz: Nat; len: nat} 28 | (s: &bstring (l, sz, len)):<> int len 29 | 30 | fun clear {l: agz; sz: Nat; len: nat} 31 | (s: &bstring (l, sz, len) >> bstring (l, sz, 0)):<> void 32 | 33 | fun char_at {l: agz; sz: Nat; len, idx: nat | idx < len} 34 | (s: &bstring (l, sz, len), idx: int idx):<> char 35 | overload [] with char_at 36 | 37 | fun set_char_at {l: agz; sz: Nat; len, idx: nat | idx < len} 38 | (s: &bstring (l, sz, len), idx: int idx, ch: char):<> void 39 | overload [] with set_char_at 40 | 41 | fun append_char {l: agz} {sz: Nat} {len: nat | len < sz-1} 42 | (s: &bstring (l, sz, len) >> bstring (l, sz, len+1), 43 | ch: char):<> void 44 | 45 | fun append_string 46 | {l: agz; sz: Nat; len: nat | len < sz; 47 | len2: nat | len + len2 < sz} 48 | (s: &bstring (l, sz, len) >> bstring (l, sz, len+len2), 49 | s2: string len2, 50 | len2: int len2):<> void 51 | 52 | fun append_bstring 53 | {l: agz; sz: Nat; len: nat | len < sz; 54 | l2: agz; sz2: Nat; len2: nat | len + len2 < sz} 55 | (s: &bstring (l, sz, len) >> bstring (l, sz, len+len2), 56 | s2: &bstring (l2, sz2, len2)):<> void 57 | 58 | absviewtype stream_vt (l: addr, sz: int, p: addr) 59 | 60 | fun stream 61 | {p, l: agz; sz: Nat; len: nat | len < sz} 62 | (pf: bstring (l, sz, len) @ p | p: ptr p):<> 63 | $Streams.stream (stream_vt (l, sz, p)) 64 | 65 | prfun unstream 66 | {p, l: agz; sz: Nat} 67 | (stream: $Streams.stream (stream_vt (l, sz, p))):<> 68 | [len: nat | len < sz] bstring (l, sz, len) @ p 69 | -------------------------------------------------------------------------------- /enablable.dats: -------------------------------------------------------------------------------- 1 | staload "enablable.sats" 2 | 3 | implement {vt:viewt@ype} empty () = 4 | let 5 | var x: vt? 6 | prval () = opt_none {vt} x 7 | in 8 | @{enabled = false, obj = x}: enablable vt 9 | end 10 | -------------------------------------------------------------------------------- /enablable.sats: -------------------------------------------------------------------------------- 1 | viewtypedef enablable (vt:viewt@ype) = 2 | [enabled: bool] @{ enabled = bool enabled, obj = opt (vt, enabled) } 3 | 4 | fun {vt:viewt@ype} empty (): enablable vt 5 | -------------------------------------------------------------------------------- /gdt.dats: -------------------------------------------------------------------------------- 1 | staload "gdt.sats" 2 | staload "trace.sats" 3 | 4 | (* Fill the GDT with the fixed entries. *) 5 | fn fill_gdt 6 | {len: int | len >= 6} 7 | (gdt: &(@[gdt_entry][len]), 8 | tss_ptr: ptr):<> void = 9 | let 10 | fn u {x: Uint16} (x: int x):<> uint16 = uint16_of (uint1_of x) 11 | fn up {x: Uint16} (x: uintptr_t x):<> uint16 = uint16_of (uint1_of x) 12 | val tss_ptr' = uintptr1_of tss_ptr 13 | (* Calculate TSS descriptor words by splitting TSS pointer into pieces. *) 14 | (* See CPU manuals for more information. *) 15 | val tssd1 = up (tss_ptr' land (uintptr1_of 0xFFFFu)) 16 | val tssd2 = up ((tss_ptr' >> 16) land uintptr1_of 0x00FFu) lor u 0x8900 17 | val tssd3 = up ((tss_ptr' >> 16) land uintptr1_of 0xFF00u) lor u 0x0000 18 | in 19 | gdt.[0] := (u 0, u 0, u 0, u 0); (* Dummy entry (the CPU doesn't use gdt[0]) *) 20 | gdt.[1] := (u 0xFFFF, u 0x0000, u 0x9A00, u 0x00CF); (* SEG_DPL0_CODE *) 21 | gdt.[2] := (u 0xFFFF, u 0x0000, u 0x9200, u 0x00CF); (* SEG_DPL0_DATA *) 22 | gdt.[3] := (u 0xFFFF, u 0x0000, u 0xFA00, u 0x00CF); (* SEG_DPL3_CODE *) 23 | gdt.[4] := (u 0xFFFF, u 0x0000, u 0xF200, u 0x00CF); (* SEG_DPL3_DATA *) 24 | gdt.[5] := (u 0x0068, tssd1, tssd2, tssd3); (* TSS descriptor *) // u 0x89AA, u 0xAA00); (* TSS descriptor *) 25 | () 26 | end 27 | 28 | %{^ 29 | extern char stack_bottom[]; 30 | #define get_stack_bottom() ((uint32_t) stack_bottom) 31 | %} 32 | extern fun get_stack_bottom (): uint32 = "mac#get_stack_bottom" 33 | 34 | (* The default task state segment. *) 35 | local 36 | fn s {x: Uint16} (x: int x):<> uint16 = uint16_of (uint1_of x) 37 | fn i {x: Uint32} (x: int x):<> uint32 = uint32_of (uint1_of x) 38 | in 39 | var tss0: tss = 40 | @{ 41 | prev = s 0, res0 = s 0, esp0 = get_stack_bottom (), 42 | ss0 = s SEG_DPL0_DATA, 43 | res1 = s 0, esp1 = i 0, 44 | ss1 = s 0, res2 = s 0, esp2 = i 0, 45 | ss2 = s 0, res3 = s 0, cr3 = i 0, 46 | eip = i 0, eflags = i 0, 47 | eax = i 0, ecx = i 0, 48 | edx = i 0, ebx = i 0, 49 | esp = i 0, ebp = i 0, 50 | esi = i 0, edi = i 0, 51 | es = s 0, res4 = s 0, 52 | cs = s 0, res5 = s 0, 53 | ss = s 0, res6 = s 0, 54 | ds = s 0, res7 = s 0, 55 | fs = s 0, res8 = s 0, 56 | gs = s 0, res9 = s 0, 57 | ldt = s 0, res10 = s 0, 58 | debug_trap = s 0, 59 | iomap_base = s 0 60 | } 61 | end 62 | 63 | (* The default GDT. *) 64 | %{^ 65 | static uint16_t the_gdt [4*6]; 66 | %} 67 | 68 | (* XXX: Should be [gdt_entry?] *) 69 | val (pf_the_gdt | the_gdt) = 70 | $extval ([l: agz] (vbox (@[gdt_entry][6] @ l) | ptr l), 71 | "the_gdt") 72 | 73 | %{^ 74 | /* Load the GDT register with the address and size of the GDT. */ 75 | static void lgdt (void *address, size_t size) 76 | { 77 | __asm__ volatile ( 78 | "subl $6,%%esp \n" 79 | "movw %%cx,(%%esp) \n" 80 | "movl %%eax,2(%%esp) \n" 81 | "lgdt (%%esp) \n" 82 | "addl $6,%%esp \n" 83 | :: "c" (size), "a" (address) 84 | : "cc" 85 | ); 86 | } 87 | 88 | /* Load data segment registers. */ 89 | static void load_data_segregs (int data_seg_sel) 90 | { 91 | __asm__ volatile ( 92 | "movw %%ax,%%ds \n" 93 | "movw %%ax,%%es \n" 94 | "movw %%ax,%%fs \n" 95 | "movw %%ax,%%gs \n" 96 | :: "a" (data_seg_sel) 97 | ); 98 | } 99 | 100 | /* Load stack segment register. */ 101 | static void load_ss (int data_seg_sel) 102 | { 103 | __asm__ volatile ( 104 | "movw %%ax,%%ss \n" 105 | :: "a" (data_seg_sel) 106 | ); 107 | } 108 | 109 | /* Load the code segment register. */ 110 | static void load_cs (int code_seg_sel) 111 | { 112 | __asm__ volatile ( 113 | "pushf \n" /* eflags */ 114 | "pushl %%eax \n" /* cs */ 115 | "pushl $1f \n" /* eip */ 116 | "iret \n" 117 | "1: \n" 118 | :: "a" (code_seg_sel) 119 | ); 120 | } 121 | 122 | /* Load the task register. */ 123 | static void ltr (int tss_seg_sel) 124 | { 125 | __asm__ volatile ( 126 | "ltr %%ax" 127 | :: "a" (tss_seg_sel) 128 | ); 129 | } 130 | %} 131 | 132 | extern fun lgdt 133 | {l: addr} {len: nat} 134 | (pf: !(@[gdt_entry][len] @ l) | 135 | address: ptr l, 136 | size: size_t (len * sizeof gdt_entry)):<> void 137 | = "lgdt" 138 | 139 | extern fun load_data_segregs 140 | {x: Uint16} (data_seg_sel: int x):<> void 141 | = "load_data_segregs" 142 | 143 | extern fun load_ss 144 | {x: Uint16} (data_seg_sel: int x):<> void 145 | = "load_ss" 146 | 147 | extern fun load_cs 148 | {x: Uint16} (code_seg_sel: int x):<> void 149 | = "load_cs" 150 | 151 | extern fun ltr 152 | {x: Uint16} (task_seg_sel: int x):<> void 153 | = "ltr" 154 | 155 | implement init () = 156 | if sizeof != size1_of 8 then begin 157 | panicloc ("sizeof is not 8.") 158 | end else begin 159 | (* Initialise the GDT. *) 160 | let prval vbox pf_the_gdt = pf_the_gdt in 161 | fill_gdt (!the_gdt, &tss0) 162 | end; 163 | 164 | (* Load the GDT. *) 165 | trace "LGDT "; 166 | let prval vbox pf_the_gdt = pf_the_gdt in 167 | lgdt (pf_the_gdt | the_gdt, 168 | size1_of_int1 (6 * int1_of sizeof)) 169 | end; 170 | 171 | (* Re-load all the data segment registers. 172 | We can use the ring 3 segments, then we don't have to keep 173 | switching. This is not a problem, because we're not using 174 | segmentation as a means of protection. *) 175 | trace "DS "; load_data_segregs SEG_DPL3_DATA; 176 | trace "SS "; load_ss SEG_DPL0_DATA; 177 | trace "CS "; load_cs SEG_DPL0_CODE; 178 | trace "LTR "; ltr SEG_DPL3_TSS 179 | end 180 | -------------------------------------------------------------------------------- /gdt.sats: -------------------------------------------------------------------------------- 1 | 2 | (* Segment selectors - these correspond to 3 | entries in the GDT. *) 4 | #define SEG_DPL0_CODE 0x08 (* Kernel-level code *) 5 | #define SEG_DPL0_DATA 0x10 (* Kernel-level data *) 6 | #define SEG_DPL3_CODE 0x1B (* User-level code *) 7 | #define SEG_DPL3_DATA 0x23 (* User-level data *) 8 | #define SEG_DPL3_TSS 0x2B (* User-level TSS *) 9 | 10 | (* The structure of the task state segment. *) 11 | typedef tss = 12 | @{ 13 | prev = uint16, res0 = uint16, esp0 = uint32, 14 | ss0 = uint16, res1 = uint16, esp1 = uint32, 15 | ss1 = uint16, res2 = uint16, esp2 = uint32, 16 | ss2 = uint16, res3 = uint16, cr3 = uint32, 17 | eip = uint32, eflags = uint32, 18 | eax = uint32, ecx = uint32, 19 | edx = uint32, ebx = uint32, 20 | esp = uint32, ebp = uint32, 21 | esi = uint32, edi = uint32, 22 | es = uint16, res4 = uint16, 23 | cs = uint16, res5 = uint16, 24 | ss = uint16, res6 = uint16, 25 | ds = uint16, res7 = uint16, 26 | fs = uint16, res8 = uint16, 27 | gs = uint16, res9 = uint16, 28 | ldt = uint16, res10 = uint16, 29 | debug_trap = uint16, 30 | iomap_base = uint16 31 | } 32 | 33 | typedef gdt_entry = @( uint16, uint16, uint16, uint16 ) 34 | 35 | fun init (): void 36 | 37 | -------------------------------------------------------------------------------- /gen_integer.lua: -------------------------------------------------------------------------------- 1 | function g(s, ...) 2 | io.write(string.format(s, ...)) 3 | end 4 | 5 | function indexed(t) 6 | return t .. "1" 7 | end 8 | 9 | function mbindexed(i,t) 10 | return i and indexed(t) or t 11 | end 12 | 13 | function sort(s) 14 | return s:sub(1,1):upper() .. s:sub(2,#s) 15 | end 16 | 17 | function max(t) 18 | return ({ 19 | byte = "CHAR_MAX", 20 | ubyte = "UCHAR_MAX", 21 | short = "SHRT_MAX", 22 | ushort = "USHRT_MAX", 23 | int = "INT_MAX", 24 | uint = "UINT_MAX", 25 | long = "LONG_MAX", 26 | ulong = "ULONG_MAX", 27 | llong = "LLONG_MAX", 28 | ullong = "ULLONG_MAX" 29 | })[t] 30 | end 31 | 32 | function min(t) 33 | return ({ 34 | byte = "CHAR_MIN", 35 | ubyte = "UCHAR_MIN", 36 | short = "SHRT_MIN", 37 | ushort = "USHRT_MIN", 38 | int = "INT_MIN", 39 | uint = "UINT_MIN", 40 | long = "LONG_MIN", 41 | ulong = "ULONG_MIN", 42 | llong = "LLONG_MIN", 43 | ullong = "ULLONG_MIN" 44 | })[t] 45 | end 46 | 47 | function unsigned(t) 48 | return ({ 49 | ubyte = true, 50 | ushort = true, 51 | uint = true, 52 | ulong = true, 53 | ullong = true 54 | })[t] 55 | end 56 | 57 | types = {"byte", "short", "int", "long", "llong", 58 | "ubyte", "ushort", "uint", "ulong", "ullong"} 59 | 60 | g [[ 61 | // Generated from gen_integer.lua 62 | staload "prelude/limits.sats" 63 | 64 | symintr imul2 65 | infixl ( / ) udiv2 umod2 66 | symintr udiv2 umod2 67 | symintr ushl ushr 68 | 69 | (********** CONVERSION **********) 70 | 71 | ]] 72 | 73 | for _, t1 in ipairs(types) do 74 | for _, t2 in ipairs(types) do 75 | if t1 == t2 then 76 | local t = t1 77 | g("castfn %s_of_%s (x: %s):<> [x: %s] %s x ; ", 78 | indexed(t), t, t, sort(t), t) 79 | g("overload %s_of with %s_of_%s\n", 80 | indexed(t), indexed(t), t) 81 | g("castfn %s_of_%s {x: %s} (x: %s x):<> %s ; ", 82 | t, indexed(t), sort(t), t, t) 83 | g("overload %s_of with %s_of_%s\n", 84 | t, t, indexed(t)) 85 | else 86 | for _, i2 in ipairs{false, true} do 87 | g("castfn %s_of_%s ", 88 | i2 and indexed(t2) or t2, 89 | indexed(t1)) 90 | g("{x: %s} (x: %s x)", sort(t2), t1) 91 | if i2 then 92 | g(":<> %s x", t2) 93 | else 94 | g(":<> %s", t2) 95 | end 96 | g(" ; overload %s_of with %s_of_%s\n", 97 | i2 and indexed(t2) or t2, 98 | i2 and indexed(t2) or t2, 99 | indexed(t1)) 100 | end 101 | end 102 | end 103 | end 104 | 105 | g [[ 106 | 107 | (********** OPERATORS **********) 108 | 109 | ]] 110 | 111 | compare_ops = { 112 | {"eq", "=", "=="}, 113 | {"ne", "!=", "<>"}, 114 | {"lt", "<", "<"}, 115 | {"gt", ">", ">"}, 116 | {"le", "<=", "<="}, 117 | {"ge", ">=", ">="} 118 | } 119 | 120 | for _, t1 in ipairs(types) do 121 | for _, t2 in ipairs(types) do 122 | for _, i1 in ipairs{false, true} do 123 | for _, i2 in ipairs{false, true} do 124 | -- comparison 125 | if t1 == t2 then 126 | for _, op in ipairs(compare_ops) do 127 | local op, sym, staop = unpack(op) 128 | 129 | g("fun %s_%s_%s ", 130 | op, mbindexed(i1,t1), mbindexed(i2,t2)) 131 | if i1 then g("{a: %s} ", sort(t1)); end 132 | if i2 then g("{b: %s} ", sort(t2)); end 133 | g("(a: %s%s, b: %s%s):<> ", 134 | t1, i1 and " a" or "", 135 | t2, i2 and " b" or "") 136 | if i1 and i2 then g("bool (a %s b)", staop) 137 | else g("bool"); end 138 | g(" = \"mac#atspre_%s\" ; ", op) 139 | g("overload %s with %s_%s_%s\n", 140 | sym, op, mbindexed(i1,t1), mbindexed(i2,t2)) 141 | end 142 | end 143 | 144 | if i1 and i2 and t1 == t2 then 145 | t = t1 146 | suffix = indexed(t) .. "_" .. indexed(t) 147 | -- ADDITION -- 148 | g("fun add_%s {a, b: %s | a + b >= %s && a + b <= %s} ", 149 | suffix, sort(t), min(t), max(t)) 150 | g("(a: %s a, b: %s b):<> %s (a+b) = \"mac#atspre_add\" ; ", 151 | t, t, t) 152 | g("overload + with add_%s\n", suffix) 153 | -- SUBTRACTION -- 154 | g("fun sub_%s {a, b: %s | a - b >= %s && a - b <= %s} ", 155 | suffix, sort(t), min(t), max(t)) 156 | g("(a: %s a, b: %s b):<> %s (a-b) = \"mac#atspre_sub\" ; ", 157 | t, t, t) 158 | g("overload - with sub_%s\n", suffix) 159 | -- MULTIPLICATION -- 160 | g("fun premul_%s {a, b: %s} ", suffix, sort(t)) 161 | g("(a: %s a, b: %s b):<> bool (a*b >= %s && a*b <= %s)", 162 | t, t, min(t), max(t)) 163 | g(" = \"atspre_premul_%s\" ; ", suffix) 164 | g("overload *? with premul_%s\n", suffix) 165 | 166 | g("fun mul_%s {a, b: %s | a*b >= %s && a*b <= %s} ", 167 | suffix, sort(t), min(t), max(t)); 168 | g("(a: %s a, b: %s b):<> %s (a*b)", t, t, t) 169 | g(" = \"mac#atspre_mul\" ; ") 170 | g("overload * with mul_%s\n", suffix) 171 | 172 | g("fun imul2_%s {a, b: %s | a*b >= %s && a*b <= %s} ", 173 | suffix, sort(t), min(t), max(t)); 174 | g("(a: %s a, b: %s b):<> (MUL (a, b, a*b) | %s (a*b))", 175 | t, t, t) 176 | g(" = \"mac#atspre_mul\" ; ") 177 | g("overload imul2 with imul2_%s\n", suffix) 178 | 179 | if unsigned(t) then 180 | g("fun land_%s {a, b: %s} ", suffix, sort(t)); 181 | g("(a: %s a, b: %s b):<> [r: %s | r <= a && r <= b] %s r", t, t, sort(t), t) 182 | g(" = \"mac#atspre_land\" ; ") 183 | g("overload land with land_%s\n", suffix) 184 | 185 | g("fun lor_%s {a, b: %s} ", suffix, sort(t)); 186 | g("(a: %s a, b: %s b):<> [r: %s | r >= a && r >= b && r <= a + b] %s r", t, t, sort(t), t) 187 | g(" = \"mac#atspre_lor\" ; ") 188 | g("overload lor with lor_%s\n", suffix) 189 | 190 | g("fun lnot_%s {a: %s} ", indexed(t), sort(t)); 191 | g("(a: %s a):<> [r: %s] %s r", t, sort(t), t) 192 | g(" = \"mac#atspre_lnot\" ; ") 193 | g("overload ~ with lnot_%s\n", indexed(t)) 194 | 195 | g("fun div_%s {a, b: %s | b <> 0} ", suffix, sort(t)); 196 | g("(a: %s a, b: %s b):<> [a/b >= 0 && a/b <= a] %s (a/b)", t, t, t) 197 | g(" = \"mac#atspre_div\" ; ") 198 | g("overload / with div_%s\n", suffix) 199 | 200 | g("fun mod_%s {a, b: %s | b <> 0} ", suffix, sort(t)); 201 | g("(a: %s a, b: %s b):<> [r: %s | r < b] %s r", 202 | t, t, sort(t), t) 203 | g(" = \"mac#atspre_mod\" ; ") 204 | g("overload mod with mod_%s\n", suffix) 205 | 206 | g("fun udiv2_%s {a, b: %s | b <> 0} ", suffix, sort(t)); 207 | g("(a: %s a, b: %s b):<> (DIV (a, b, a/b) | %s (a/b))", t, t, t) 208 | g(" = \"mac#atspre_div\" ; ") 209 | g("overload udiv2 with udiv2_%s\n", suffix) 210 | 211 | g("fun umod2_%s {a, b: %s | b <> 0} ", suffix, sort(t)); 212 | g("(a: %s a, b: %s b):<> [r: %s | r < b] (DIVMOD (a, b, a/b, r) | %s r)", t, t, sort(t), t) 213 | g(" = \"mac#atspre_mod\" ; ") 214 | g("overload umod2 with umod2_%s\n", suffix) 215 | 216 | g("fun ushl_%s {x: %s; n: nat; y: %s} ", suffix, sort(t), sort(t)); 217 | g("(pf: SHL (x, n, y) | x: %s x, n: int n):<> %s y", t, t) 218 | g(" = \"mac#atspre_shl\" ; ") 219 | g("overload ushl with ushl_%s\n", suffix) 220 | 221 | g("fun ushr_%s {x: %s; n: nat} ", suffix, sort(t)); 222 | g("(x: %s x, n: int n):<> [y: %s] (SHR (x, n, y) | %s y)", t, sort(t), t) 223 | g(" = \"mac#atspre_shr\" ; ") 224 | g("overload ushr with ushr_%s\n", suffix) 225 | 226 | g("fun shr_%s {x: %s; n: nat} ", suffix, sort(t)); 227 | g("(x: %s x, n: int n):<> [y: %s] %s y", t, sort(t), t) 228 | g(" = \"mac#atspre_shr\" ; ") 229 | g("overload >> with shr_%s\n", suffix) 230 | 231 | end 232 | end 233 | if t1 == t2 and unsigned(t1) and not i1 and not i2 then 234 | t = t1 235 | suffix = indexed(t) .. "_" .. indexed(t) 236 | 237 | g("fun land_%s ", suffix); 238 | g("(a: %s, b: %s):<> %s", t, t, t) 239 | g(" = \"mac#atspre_land\" ; ") 240 | g("overload land with land_%s\n", suffix) 241 | 242 | g("fun lor_%s ", suffix); 243 | g("(a: %s, b: %s):<> %s", t, t, t) 244 | g(" = \"mac#atspre_lor\" ; ") 245 | g("overload lor with lor_%s\n", suffix) 246 | 247 | g("fun lnot_%s ", t); 248 | g("(a: %s):<> %s", t, t) 249 | g(" = \"mac#atspre_lnot\" ; ") 250 | g("overload ~ with lnot_%s\n", t) 251 | 252 | g("fun shr_%s {n: nat} ", t); 253 | g("(a: %s, n: int n):<> %s", t, t) 254 | g(" = \"mac#atspre_shr\" ; ") 255 | g("overload >> with shr_%s\n", t) 256 | end 257 | end 258 | end 259 | end 260 | end 261 | 262 | -------------------------------------------------------------------------------- /interrupts.dats: -------------------------------------------------------------------------------- 1 | staload "interrupts.sats" 2 | staload "portio.sats" 3 | staload GDT = "gdt.sats" 4 | staload "trace.sats" 5 | 6 | (* PIC registers *) 7 | #define PIC1_CMD 0x20 8 | #define PIC1_DATA 0x21 9 | #define PIC2_CMD 0xA0 10 | #define PIC2_DATA 0xA1 11 | 12 | (* PIC commands *) 13 | #define PIC_ACK 0x20 14 | #define ICW1_ICW4 0x01 15 | #define ICW1_SINGLE 0x02 16 | #define ICW1_INTERVAL4 0x04 17 | #define ICW1_LEVEL 0x08 18 | #define ICW1_INIT 0x10 19 | #define ICW4_8086 0x01 20 | #define ICW4_AUTO 0x02 21 | #define ICW4_BUF_SLAVE 0x08 22 | #define ICW4_BUF_MASTER 0x0C 23 | #define ICW4_SFNM 0x10 24 | 25 | typedef interrupt_descriptor = @( uint16, uint16, uint16, uint16 ) 26 | 27 | %{^ 28 | extern void (*interrupt_handlers[])(); 29 | struct { uint16_t a,b,c,d; } the_idt[256]; 30 | %} 31 | 32 | val (pf_interrupt_handlers | interrupt_handlers) = 33 | $extval ([l: agz] (vbox (@[interrupt_handler][256] @ l) | ptr l), 34 | "interrupt_handlers") 35 | 36 | val (pf_the_idt | the_idt) = 37 | $extval ([l: agz] (vbox (@[interrupt_descriptor][256] @ l) | ptr l), 38 | "the_idt") 39 | 40 | fn default_interrupt_handler 41 | (vector: interrupt_vector, 42 | stack: &interrupt_stack): void = 43 | begin 44 | trace "tick "; 45 | if vector >= 0x20 && vector < 0x30 then 46 | ack_irq (irq_of_vector vector) 47 | end 48 | 49 | %{^ 50 | static void lidt (void *idt) 51 | { 52 | __asm__ volatile ( 53 | "subl $6,%%esp \n" 54 | "movw %%cx,(%%esp) \n" 55 | "movl %%eax,2(%%esp) \n" 56 | "lidt (%%esp) \n" 57 | "addl $6,%%esp \n" 58 | :: "c" (256*8), "a" (idt) 59 | : "cc" 60 | ); 61 | } 62 | %} 63 | 64 | extern fun lidt {l: agz} 65 | (pf: !(@[interrupt_descriptor][256] @ l) | 66 | p: ptr l):<> void = "lidt" 67 | 68 | fn w {x: Uint16} (x: int x):<> uint16 = uint16_of (uint1_of x) 69 | fn b {x: Uint8} (x: int x):<> uint8 = uint8_of (uint1_of x) 70 | 71 | fn remap_pics ():<> void = 72 | let 73 | val pic1_offset = 0x20 74 | val pic2_offset = 0x28 75 | in 76 | outb (w PIC1_CMD, b (ICW1_INIT + ICW1_ICW4)); io_wait (); 77 | outb (w PIC2_CMD, b (ICW1_INIT + ICW1_ICW4)); io_wait (); 78 | outb (w PIC1_DATA, b pic1_offset); io_wait (); 79 | outb (w PIC2_DATA, b pic2_offset); io_wait (); 80 | outb (w PIC1_DATA, b 4); io_wait (); 81 | outb (w PIC2_DATA, b 2); io_wait (); 82 | outb (w PIC1_DATA, b ICW4_8086); io_wait (); 83 | outb (w PIC2_DATA, b ICW4_8086); io_wait (); 84 | outb (w PIC1_DATA, b 0xFF); 85 | outb (w PIC2_DATA, b 0xFF) 86 | end 87 | 88 | implement init () = 89 | begin 90 | // Fill in the IDT and handler table. 91 | let var i: Int in 92 | for* {i: nat | i <= 256} .<256-i>. (i: int i) 93 | => (i := 0; i < 256; i := i + 1) 94 | begin 95 | let 96 | // Get isr address from interrupt handler table. 97 | val isr_address = uintptr_of_handler ( 98 | let prval vbox pf_interrupt_handlers = pf_interrupt_handlers in 99 | interrupt_handlers->[i] 100 | end) where { 101 | extern castfn uintptr_of_handler (x: interrupt_handler):<> [x: Uintptr] uintptr_t x 102 | } 103 | prval vbox pf_the_idt = pf_the_idt 104 | in 105 | // Create IDT entry. 106 | the_idt->[i] := @( 107 | uint16_of (uint1_of (isr_address land uintptr1_of 0xFFFFu)), 108 | w $GDT.SEG_DPL0_CODE, 109 | w 0x8E00, 110 | uint16_of (uint1_of ((isr_address >> 16) land uintptr1_of 0xFFFFu)) 111 | ); 112 | end; 113 | let prval vbox pf_interrupt_handlers = pf_interrupt_handlers in 114 | // Set interrupt handler table entry to the default interrupt handler. 115 | interrupt_handlers->[i] := default_interrupt_handler 116 | end 117 | end 118 | end; 119 | trace "IDT "; 120 | let prval vbox pf_the_idt = pf_the_idt in 121 | lidt (pf_the_idt | the_idt) 122 | end; 123 | trace "PIC "; 124 | remap_pics (); 125 | // Enable the cascade IRQ so that the slave PIC can work. 126 | unmask_irq 2 127 | end 128 | 129 | implement set_handler (vector, handler) = 130 | let prval vbox pf_interrupt_handlers = pf_interrupt_handlers in 131 | interrupt_handlers->[vector] := handler 132 | end 133 | 134 | implement clear_handler (vector) = 135 | let prval vbox pf_interrupt_handlers = pf_interrupt_handlers in 136 | interrupt_handlers->[vector] := default_interrupt_handler 137 | end 138 | 139 | implement vector_of_irq (irq) = irq + 0x20 140 | implement irq_of_vector (vector) = vector - 0x20 141 | 142 | prval SHL_1_7: SHL (1, 7, 128) = (,(pf_exp2_const 7), MULind(MULbas())) 143 | 144 | implement unmask_irq ([irq: int] irq) = 145 | if irq < 8 then begin 146 | (* Master PIC *) 147 | let 148 | val a = inb (w PIC1_DATA) 149 | prval pf_bit = SHL_make {1, irq} () 150 | prval () = SHL_le (pf_bit, SHL_1_7) 151 | val bit = ushl (pf_bit | 1u, irq) 152 | val a = a land ~ uint8_of bit 153 | val () = outb (w PIC1_DATA, a) 154 | in () end 155 | end else begin 156 | (* Slave PIC *) 157 | let 158 | val a = inb (w PIC2_DATA) 159 | prval pf_bit = SHL_make {1,irq-8} () 160 | prval () = SHL_le (pf_bit, SHL_1_7) 161 | val bit = ushl (pf_bit | 1u, irq-8) 162 | val a = a land ~ uint8_of bit 163 | val () = outb (w PIC2_DATA, a) 164 | in () end 165 | end 166 | 167 | implement mask_irq ([irq: int] irq) = 168 | if irq < 8 then begin 169 | (* Master PIC *) 170 | let 171 | val a = inb (w PIC1_DATA) 172 | prval pf_bit = SHL_make {1, irq} () 173 | prval () = SHL_le (pf_bit, SHL_1_7) 174 | val bit = ushl (pf_bit | 1u, irq) 175 | val a = a lor uint8_of bit 176 | val () = outb (w PIC1_DATA, a) 177 | in () end 178 | end else begin 179 | (* Slave PIC *) 180 | let 181 | val a = inb (w PIC2_DATA) 182 | prval pf_bit = SHL_make {1,irq-8} () 183 | prval () = SHL_le (pf_bit, SHL_1_7) 184 | val bit = ushl (pf_bit | 1u, irq-8) 185 | val a = a lor uint8_of bit 186 | val () = outb (w PIC2_DATA, a) 187 | in () end 188 | end 189 | 190 | implement ack_irq (n) = 191 | begin 192 | if n >= 8 then outb (w PIC2_CMD, b PIC_ACK); 193 | outb (w PIC1_CMD, b PIC_ACK) 194 | end 195 | -------------------------------------------------------------------------------- /interrupts.sats: -------------------------------------------------------------------------------- 1 | (* Data structure created with the "pusha" instruction. *) 2 | typedef pusha_struct = 3 | @{ 4 | edi = uint32, 5 | esi = uint32, 6 | ebp = uint32, 7 | esp = uint32, 8 | ebx = uint32, 9 | edx = uint32, 10 | ecx = uint32, 11 | eax = uint32 12 | } 13 | 14 | (* Structure that arises from an interrupt. *) 15 | typedef interrupt_stack = 16 | @{ 17 | (* from isr.S *) 18 | registers = pusha_struct, 19 | (* from CPU *) 20 | error_code = uint32, 21 | eip = uint32, 22 | cs = uint32, 23 | eflags = uint32, 24 | (* esp and ss are only present in a user->kernel switch *) 25 | esp = uint32, 26 | ss = uint32 27 | } 28 | 29 | typedef interrupt_vector = [x: nat | x < 256] int x 30 | typedef irq_interrupt_vector = [x: int | x >= 0x20 && x < 0x30] int x 31 | typedef irq_number = [x: nat | x < 16] int x 32 | 33 | (* Type of interrupt handler functions. Note that interrupt handlers 34 | and interrupt service routines (ISRs) are different. 35 | ISRs call the handlers. *) 36 | typedef interrupt_handler = 37 | (interrupt_vector, &interrupt_stack) - void 38 | (* XXX: !ref shouldn't be there! *) 39 | 40 | fun init (): void 41 | fun enable_interrupts_globally ():<> void = "mac#sti" 42 | fun disable_interrupts_globally ():<> void = "mac#cli" 43 | fun set_handler 44 | (vector: interrupt_vector, 45 | handler: interrupt_handler): void 46 | fun clear_handler (vector: interrupt_vector): void 47 | 48 | fun vector_of_irq (irq: irq_number):<> irq_interrupt_vector 49 | fun irq_of_vector (vector: irq_interrupt_vector):<> irq_number 50 | 51 | fun unmask_irq (irq: irq_number):<> void (* unmask (enable) IRQ *) 52 | fun mask_irq (irq: irq_number):<> void (* mask (disable) IRQ *) 53 | fun ack_irq (irq: irq_number):<> void (* acknowledge IRQ n *) 54 | 55 | %{# 56 | #define sti() do { __asm__ volatile ("sti"); } while (0) 57 | #define cli() do { __asm__ volatile ("cli"); } while (0) 58 | %} 59 | -------------------------------------------------------------------------------- /isr.S: -------------------------------------------------------------------------------- 1 | /* Invoke interrupt handler. 2 | eax = interrupt vector */ 3 | invoke_handler: 4 | pushl %esp /* arg 2 = pointer to pusha struct */ 5 | pushl %eax /* arg 1 = interrupt vector */ 6 | movl interrupt_handlers(,%eax,4),%eax 7 | call *%eax 8 | addl $8,%esp /* pop args */ 9 | popa 10 | addl $4,%esp /* pop error code */ 11 | iret 12 | 13 | #define EXC_HANDLER(n) \ 14 | isr##n: ;\ 15 | pusha ;\ 16 | movl $n,%eax ;\ 17 | movl $invoke_handler,%edx ;\ 18 | jmp *%edx 19 | 20 | #define INT_HANDLER(n) \ 21 | isr##n: ;\ 22 | pushl %eax /* dummy error code */ ;\ 23 | pusha ;\ 24 | movl $n,%eax ;\ 25 | movl $invoke_handler,%edx ;\ 26 | jmp *%edx 27 | 28 | EXC_HANDLER(0) 29 | EXC_HANDLER(1) 30 | EXC_HANDLER(2) 31 | EXC_HANDLER(3) 32 | EXC_HANDLER(4) 33 | EXC_HANDLER(5) 34 | EXC_HANDLER(6) 35 | EXC_HANDLER(7) 36 | EXC_HANDLER(8) 37 | EXC_HANDLER(9) 38 | EXC_HANDLER(10) 39 | EXC_HANDLER(11) 40 | EXC_HANDLER(12) 41 | EXC_HANDLER(13) 42 | EXC_HANDLER(14) 43 | EXC_HANDLER(15) 44 | EXC_HANDLER(16) 45 | EXC_HANDLER(17) 46 | EXC_HANDLER(18) 47 | EXC_HANDLER(19) 48 | INT_HANDLER(20) 49 | INT_HANDLER(21) 50 | INT_HANDLER(22) 51 | INT_HANDLER(23) 52 | INT_HANDLER(24) 53 | INT_HANDLER(25) 54 | INT_HANDLER(26) 55 | INT_HANDLER(27) 56 | INT_HANDLER(28) 57 | INT_HANDLER(29) 58 | INT_HANDLER(30) 59 | INT_HANDLER(31) 60 | INT_HANDLER(32) 61 | INT_HANDLER(33) 62 | INT_HANDLER(34) 63 | INT_HANDLER(35) 64 | INT_HANDLER(36) 65 | INT_HANDLER(37) 66 | INT_HANDLER(38) 67 | INT_HANDLER(39) 68 | INT_HANDLER(40) 69 | INT_HANDLER(41) 70 | INT_HANDLER(42) 71 | INT_HANDLER(43) 72 | INT_HANDLER(44) 73 | INT_HANDLER(45) 74 | INT_HANDLER(46) 75 | INT_HANDLER(47) 76 | INT_HANDLER(48) 77 | INT_HANDLER(49) 78 | INT_HANDLER(50) 79 | INT_HANDLER(51) 80 | INT_HANDLER(52) 81 | INT_HANDLER(53) 82 | INT_HANDLER(54) 83 | INT_HANDLER(55) 84 | INT_HANDLER(56) 85 | INT_HANDLER(57) 86 | INT_HANDLER(58) 87 | INT_HANDLER(59) 88 | INT_HANDLER(60) 89 | INT_HANDLER(61) 90 | INT_HANDLER(62) 91 | INT_HANDLER(63) 92 | INT_HANDLER(64) 93 | INT_HANDLER(65) 94 | INT_HANDLER(66) 95 | INT_HANDLER(67) 96 | INT_HANDLER(68) 97 | INT_HANDLER(69) 98 | INT_HANDLER(70) 99 | INT_HANDLER(71) 100 | INT_HANDLER(72) 101 | INT_HANDLER(73) 102 | INT_HANDLER(74) 103 | INT_HANDLER(75) 104 | INT_HANDLER(76) 105 | INT_HANDLER(77) 106 | INT_HANDLER(78) 107 | INT_HANDLER(79) 108 | INT_HANDLER(80) 109 | INT_HANDLER(81) 110 | INT_HANDLER(82) 111 | INT_HANDLER(83) 112 | INT_HANDLER(84) 113 | INT_HANDLER(85) 114 | INT_HANDLER(86) 115 | INT_HANDLER(87) 116 | INT_HANDLER(88) 117 | INT_HANDLER(89) 118 | INT_HANDLER(90) 119 | INT_HANDLER(91) 120 | INT_HANDLER(92) 121 | INT_HANDLER(93) 122 | INT_HANDLER(94) 123 | INT_HANDLER(95) 124 | INT_HANDLER(96) 125 | INT_HANDLER(97) 126 | INT_HANDLER(98) 127 | INT_HANDLER(99) 128 | INT_HANDLER(100) 129 | INT_HANDLER(101) 130 | INT_HANDLER(102) 131 | INT_HANDLER(103) 132 | INT_HANDLER(104) 133 | INT_HANDLER(105) 134 | INT_HANDLER(106) 135 | INT_HANDLER(107) 136 | INT_HANDLER(108) 137 | INT_HANDLER(109) 138 | INT_HANDLER(110) 139 | INT_HANDLER(111) 140 | INT_HANDLER(112) 141 | INT_HANDLER(113) 142 | INT_HANDLER(114) 143 | INT_HANDLER(115) 144 | INT_HANDLER(116) 145 | INT_HANDLER(117) 146 | INT_HANDLER(118) 147 | INT_HANDLER(119) 148 | INT_HANDLER(120) 149 | INT_HANDLER(121) 150 | INT_HANDLER(122) 151 | INT_HANDLER(123) 152 | INT_HANDLER(124) 153 | INT_HANDLER(125) 154 | INT_HANDLER(126) 155 | INT_HANDLER(127) 156 | INT_HANDLER(128) 157 | INT_HANDLER(129) 158 | INT_HANDLER(130) 159 | INT_HANDLER(131) 160 | INT_HANDLER(132) 161 | INT_HANDLER(133) 162 | INT_HANDLER(134) 163 | INT_HANDLER(135) 164 | INT_HANDLER(136) 165 | INT_HANDLER(137) 166 | INT_HANDLER(138) 167 | INT_HANDLER(139) 168 | INT_HANDLER(140) 169 | INT_HANDLER(141) 170 | INT_HANDLER(142) 171 | INT_HANDLER(143) 172 | INT_HANDLER(144) 173 | INT_HANDLER(145) 174 | INT_HANDLER(146) 175 | INT_HANDLER(147) 176 | INT_HANDLER(148) 177 | INT_HANDLER(149) 178 | INT_HANDLER(150) 179 | INT_HANDLER(151) 180 | INT_HANDLER(152) 181 | INT_HANDLER(153) 182 | INT_HANDLER(154) 183 | INT_HANDLER(155) 184 | INT_HANDLER(156) 185 | INT_HANDLER(157) 186 | INT_HANDLER(158) 187 | INT_HANDLER(159) 188 | INT_HANDLER(160) 189 | INT_HANDLER(161) 190 | INT_HANDLER(162) 191 | INT_HANDLER(163) 192 | INT_HANDLER(164) 193 | INT_HANDLER(165) 194 | INT_HANDLER(166) 195 | INT_HANDLER(167) 196 | INT_HANDLER(168) 197 | INT_HANDLER(169) 198 | INT_HANDLER(170) 199 | INT_HANDLER(171) 200 | INT_HANDLER(172) 201 | INT_HANDLER(173) 202 | INT_HANDLER(174) 203 | INT_HANDLER(175) 204 | INT_HANDLER(176) 205 | INT_HANDLER(177) 206 | INT_HANDLER(178) 207 | INT_HANDLER(179) 208 | INT_HANDLER(180) 209 | INT_HANDLER(181) 210 | INT_HANDLER(182) 211 | INT_HANDLER(183) 212 | INT_HANDLER(184) 213 | INT_HANDLER(185) 214 | INT_HANDLER(186) 215 | INT_HANDLER(187) 216 | INT_HANDLER(188) 217 | INT_HANDLER(189) 218 | INT_HANDLER(190) 219 | INT_HANDLER(191) 220 | INT_HANDLER(192) 221 | INT_HANDLER(193) 222 | INT_HANDLER(194) 223 | INT_HANDLER(195) 224 | INT_HANDLER(196) 225 | INT_HANDLER(197) 226 | INT_HANDLER(198) 227 | INT_HANDLER(199) 228 | INT_HANDLER(200) 229 | INT_HANDLER(201) 230 | INT_HANDLER(202) 231 | INT_HANDLER(203) 232 | INT_HANDLER(204) 233 | INT_HANDLER(205) 234 | INT_HANDLER(206) 235 | INT_HANDLER(207) 236 | INT_HANDLER(208) 237 | INT_HANDLER(209) 238 | INT_HANDLER(210) 239 | INT_HANDLER(211) 240 | INT_HANDLER(212) 241 | INT_HANDLER(213) 242 | INT_HANDLER(214) 243 | INT_HANDLER(215) 244 | INT_HANDLER(216) 245 | INT_HANDLER(217) 246 | INT_HANDLER(218) 247 | INT_HANDLER(219) 248 | INT_HANDLER(220) 249 | INT_HANDLER(221) 250 | INT_HANDLER(222) 251 | INT_HANDLER(223) 252 | INT_HANDLER(224) 253 | INT_HANDLER(225) 254 | INT_HANDLER(226) 255 | INT_HANDLER(227) 256 | INT_HANDLER(228) 257 | INT_HANDLER(229) 258 | INT_HANDLER(230) 259 | INT_HANDLER(231) 260 | INT_HANDLER(232) 261 | INT_HANDLER(233) 262 | INT_HANDLER(234) 263 | INT_HANDLER(235) 264 | INT_HANDLER(236) 265 | INT_HANDLER(237) 266 | INT_HANDLER(238) 267 | INT_HANDLER(239) 268 | INT_HANDLER(240) 269 | INT_HANDLER(241) 270 | INT_HANDLER(242) 271 | INT_HANDLER(243) 272 | INT_HANDLER(244) 273 | INT_HANDLER(245) 274 | INT_HANDLER(246) 275 | INT_HANDLER(247) 276 | INT_HANDLER(248) 277 | INT_HANDLER(249) 278 | INT_HANDLER(250) 279 | INT_HANDLER(251) 280 | INT_HANDLER(252) 281 | INT_HANDLER(253) 282 | INT_HANDLER(254) 283 | INT_HANDLER(255) 284 | 285 | /*****************************************************************/ 286 | 287 | /* Interrupt handler table. 288 | At start-up, this contains the addresses of all the isr 289 | functions. These are then replaced by interrupt handler 290 | functions. */ 291 | 292 | .data 293 | .global interrupt_handlers 294 | interrupt_handlers: 295 | .int isr0 296 | .int isr1 297 | .int isr2 298 | .int isr3 299 | .int isr4 300 | .int isr5 301 | .int isr6 302 | .int isr7 303 | .int isr8 304 | .int isr9 305 | .int isr10 306 | .int isr11 307 | .int isr12 308 | .int isr13 309 | .int isr14 310 | .int isr15 311 | .int isr16 312 | .int isr17 313 | .int isr18 314 | .int isr19 315 | .int isr20 316 | .int isr21 317 | .int isr22 318 | .int isr23 319 | .int isr24 320 | .int isr25 321 | .int isr26 322 | .int isr27 323 | .int isr28 324 | .int isr29 325 | .int isr30 326 | .int isr31 327 | .int isr32 328 | .int isr33 329 | .int isr34 330 | .int isr35 331 | .int isr36 332 | .int isr37 333 | .int isr38 334 | .int isr39 335 | .int isr40 336 | .int isr41 337 | .int isr42 338 | .int isr43 339 | .int isr44 340 | .int isr45 341 | .int isr46 342 | .int isr47 343 | .int isr48 344 | .int isr49 345 | .int isr50 346 | .int isr51 347 | .int isr52 348 | .int isr53 349 | .int isr54 350 | .int isr55 351 | .int isr56 352 | .int isr57 353 | .int isr58 354 | .int isr59 355 | .int isr60 356 | .int isr61 357 | .int isr62 358 | .int isr63 359 | .int isr64 360 | .int isr65 361 | .int isr66 362 | .int isr67 363 | .int isr68 364 | .int isr69 365 | .int isr70 366 | .int isr71 367 | .int isr72 368 | .int isr73 369 | .int isr74 370 | .int isr75 371 | .int isr76 372 | .int isr77 373 | .int isr78 374 | .int isr79 375 | .int isr80 376 | .int isr81 377 | .int isr82 378 | .int isr83 379 | .int isr84 380 | .int isr85 381 | .int isr86 382 | .int isr87 383 | .int isr88 384 | .int isr89 385 | .int isr90 386 | .int isr91 387 | .int isr92 388 | .int isr93 389 | .int isr94 390 | .int isr95 391 | .int isr96 392 | .int isr97 393 | .int isr98 394 | .int isr99 395 | .int isr100 396 | .int isr101 397 | .int isr102 398 | .int isr103 399 | .int isr104 400 | .int isr105 401 | .int isr106 402 | .int isr107 403 | .int isr108 404 | .int isr109 405 | .int isr110 406 | .int isr111 407 | .int isr112 408 | .int isr113 409 | .int isr114 410 | .int isr115 411 | .int isr116 412 | .int isr117 413 | .int isr118 414 | .int isr119 415 | .int isr120 416 | .int isr121 417 | .int isr122 418 | .int isr123 419 | .int isr124 420 | .int isr125 421 | .int isr126 422 | .int isr127 423 | .int isr128 424 | .int isr129 425 | .int isr130 426 | .int isr131 427 | .int isr132 428 | .int isr133 429 | .int isr134 430 | .int isr135 431 | .int isr136 432 | .int isr137 433 | .int isr138 434 | .int isr139 435 | .int isr140 436 | .int isr141 437 | .int isr142 438 | .int isr143 439 | .int isr144 440 | .int isr145 441 | .int isr146 442 | .int isr147 443 | .int isr148 444 | .int isr149 445 | .int isr150 446 | .int isr151 447 | .int isr152 448 | .int isr153 449 | .int isr154 450 | .int isr155 451 | .int isr156 452 | .int isr157 453 | .int isr158 454 | .int isr159 455 | .int isr160 456 | .int isr161 457 | .int isr162 458 | .int isr163 459 | .int isr164 460 | .int isr165 461 | .int isr166 462 | .int isr167 463 | .int isr168 464 | .int isr169 465 | .int isr170 466 | .int isr171 467 | .int isr172 468 | .int isr173 469 | .int isr174 470 | .int isr175 471 | .int isr176 472 | .int isr177 473 | .int isr178 474 | .int isr179 475 | .int isr180 476 | .int isr181 477 | .int isr182 478 | .int isr183 479 | .int isr184 480 | .int isr185 481 | .int isr186 482 | .int isr187 483 | .int isr188 484 | .int isr189 485 | .int isr190 486 | .int isr191 487 | .int isr192 488 | .int isr193 489 | .int isr194 490 | .int isr195 491 | .int isr196 492 | .int isr197 493 | .int isr198 494 | .int isr199 495 | .int isr200 496 | .int isr201 497 | .int isr202 498 | .int isr203 499 | .int isr204 500 | .int isr205 501 | .int isr206 502 | .int isr207 503 | .int isr208 504 | .int isr209 505 | .int isr210 506 | .int isr211 507 | .int isr212 508 | .int isr213 509 | .int isr214 510 | .int isr215 511 | .int isr216 512 | .int isr217 513 | .int isr218 514 | .int isr219 515 | .int isr220 516 | .int isr221 517 | .int isr222 518 | .int isr223 519 | .int isr224 520 | .int isr225 521 | .int isr226 522 | .int isr227 523 | .int isr228 524 | .int isr229 525 | .int isr230 526 | .int isr231 527 | .int isr232 528 | .int isr233 529 | .int isr234 530 | .int isr235 531 | .int isr236 532 | .int isr237 533 | .int isr238 534 | .int isr239 535 | .int isr240 536 | .int isr241 537 | .int isr242 538 | .int isr243 539 | .int isr244 540 | .int isr245 541 | .int isr246 542 | .int isr247 543 | .int isr248 544 | .int isr249 545 | .int isr250 546 | .int isr251 547 | .int isr252 548 | .int isr253 549 | .int isr254 550 | .int isr255 551 | -------------------------------------------------------------------------------- /kernel.ld: -------------------------------------------------------------------------------- 1 | ENTRY (_start) 2 | OUTPUT_FORMAT(elf32-i386) 3 | 4 | /* Physical base address of kernel. 5 | Boot loader loads the kernel image here. */ 6 | _phys_base = 0x00100000 ; 7 | 8 | /* Virtual base address of kernel. 9 | This is the address the kernel will run at, 10 | after paging is enabled in start.S. */ 11 | _virt_base = 0x00100000 ; 12 | 13 | PHDRS { 14 | physical PT_LOAD FLAGS(7) ; 15 | virtual PT_LOAD FLAGS(7) ; 16 | } 17 | 18 | SECTIONS { 19 | .start _phys_base : AT(_phys_base) { 20 | _text_start = . ; 21 | /* The multiboot header must be near the start of the image. 22 | It is not referenced by any code, hence "KEEP" to avoid 23 | it being discarded. */ 24 | KEEP(*(multiboot)) 25 | /* The start-up code that runs before paging is enabled. 26 | This must be linked at physical addresses. */ 27 | *(startup) 28 | . = ALIGN(32) ; 29 | } :physical 30 | 31 | /* Kernel code starts at virtual addresses. */ 32 | .text . - _phys_base + _virt_base : AT( _phys_base + SIZEOF(.start) ) { 33 | *(.text .text.*) 34 | . = ALIGN(32) ; 35 | } :virtual 36 | 37 | .rodata : { 38 | *(.rodata .rodata.*) 39 | . = ALIGN(32) ; 40 | } 41 | 42 | .data : { 43 | *(.data .data.*) 44 | . = ALIGN(32) ; 45 | } 46 | 47 | .bss : { 48 | _bss_start = . - _virt_base + _phys_base ; 49 | *(.bss .bss.*) 50 | *(COMMON) 51 | 52 | /* Allocate aligned memory for initial page tables. */ 53 | . = ALIGN(4096) ; 54 | boot_page_directory = . - _virt_base + _phys_base ; 55 | . = . + 1 ; 56 | . = ALIGN(4096) ; 57 | boot_page_table = . - _virt_base + _phys_base ; 58 | . = . + 1 ; 59 | . = ALIGN(4096) ; 60 | _bss_end = . - _virt_base + _phys_base ; 61 | } 62 | 63 | _kernel_size = . - _virt_base ; 64 | 65 | /DISCARD/ : { 66 | *(.note .note*) 67 | *(.comment) 68 | *(.eh_frame) /* eh_frame is not used. */ 69 | } 70 | } 71 | -------------------------------------------------------------------------------- /multiboot.sats: -------------------------------------------------------------------------------- 1 | staload "bitflags.sats" 2 | staload "prelude/limits.sats" 3 | 4 | #define MULTIBOOT_MBH_MAGIC 0x1BADB002 // magic number in multiboot header 5 | #define MULTIBOOT_BOOT_MAGIC 0x2BADB002 // magic number in eax at start-up 6 | 7 | #define MBI_MEM_XXX 0 8 | #define MBI_BOOT_DEVICE 1 9 | #define MBI_CMDLINE 2 10 | #define MBI_MODS_XXX 3 11 | #define MBI_AOUT_SYMS 4 12 | #define MBI_ELF_SYMS 5 13 | #define MBI_MMAP_XXX 6 14 | #define MBI_DRIVES_XXX 8 15 | #define MBI_BOOT_LOADER_NAME 9 16 | #define MBI_APM_TABLE 10 17 | #define MBI_VBE_XXX 11 18 | 19 | viewtypedef mb_info = [flags: Uint32] @{ 20 | flags = uint32 flags, 21 | mem_lower = uint32, 22 | mem_upper = uint32, 23 | boot_device = uint32, 24 | cmd_line = uint32, 25 | mods_count = uint32, 26 | mods_addr = uint32, 27 | (* Only valid for ELF - aout kludge 28 | uses different fields here. *) 29 | e_shnum = uint32, 30 | e_shentsize = uint32, 31 | e_shaddr = uint32, 32 | e_shstrndx = uint32, 33 | mmap_length = uint32, 34 | mmap_addr = uint32, 35 | drives_length = uint32, 36 | drives_addr = uint32, 37 | config_table = uint32, 38 | boot_loader_name = opt (string, bit_is_set (flags, MBI_BOOT_LOADER_NAME)), 39 | apm_table = uint32, 40 | vbe_control_info = uint32, 41 | vbe_mode_info = uint32, 42 | vbe_mode = uint16, 43 | vbe_interface_seg = uint16, 44 | vbe_interface_off = uint16, 45 | vbe_interface_len = uint16 46 | } 47 | 48 | typedef mb_module = @{ 49 | mod_start = uint32, 50 | mod_end = uint32, 51 | string = uint32, 52 | reserved = uint32 53 | } 54 | 55 | typedef mb_mmap = @{ 56 | size = uint32, 57 | base_addr = uint64, 58 | length = uint64, 59 | type = uint32 60 | } 61 | 62 | typedef mb_drive = @{ 63 | size = uint32, 64 | drive_number = uint8, 65 | drive_mode = uint8, 66 | drive_cylinders = uint16, 67 | drive_heads = uint8, 68 | drive_sectors = uint8, 69 | drive_ports = uint16 // array 70 | } 71 | -------------------------------------------------------------------------------- /portio.dats: -------------------------------------------------------------------------------- 1 | staload "portio.sats" 2 | 3 | implement io_wait () = 4 | let 5 | var i: Int 6 | in 7 | for* {i: nat | i <= 16} .<16-i>. (i: int i) 8 | => (i := 0; i < 16; i := i + 1) 9 | outb (uint16_of 0x80u, uint8_of 0u) 10 | end 11 | 12 | -------------------------------------------------------------------------------- /portio.sats: -------------------------------------------------------------------------------- 1 | (* x86 I/O port interface. *) 2 | 3 | %{# 4 | static inline void outb(uint16_t port, uint8_t value) 5 | { 6 | __asm__ volatile ("outb %%al,%%dx" :: "a" (value), "d" (port)); 7 | } 8 | 9 | static inline void outw(uint16_t port, uint16_t value) 10 | { 11 | __asm__ volatile ("outw %%ax,%%dx" :: "a" (value), "d" (port)); 12 | } 13 | 14 | static inline void outl(uint16_t port, uint32_t value) 15 | { 16 | __asm__ volatile ("outl %%eax,%%dx" :: "a" (value), "d" (port)); 17 | } 18 | 19 | static inline uint8_t inb(uint16_t port) 20 | { 21 | uint8_t value; 22 | __asm__ volatile ("inb %%dx,%%al" : "=a" (value) : "d" (port)); 23 | return value; 24 | } 25 | 26 | static inline uint16_t inw(uint16_t port) 27 | { 28 | uint16_t value; 29 | __asm__ volatile ("inw %%dx,%%ax" : "=a" (value) : "d" (port)); 30 | return value; 31 | } 32 | 33 | static inline uint32_t inl(uint16_t port) 34 | { 35 | uint32_t value; 36 | __asm__ volatile ("inl %%dx,%%eax" : "=a" (value) : "d" (port)); 37 | return value; 38 | } 39 | %} 40 | 41 | fun inb (port: uint16):<> uint8 = "mac#inb" 42 | fun inw (port: uint16):<> uint16 = "mac#inw" 43 | fun inl (port: uint16):<> uint32 = "mac#inl" 44 | fun outb (port: uint16, value: uint8):<> void = "mac#outb" 45 | fun outw (port: uint16, value: uint16):<> void = "mac#outb" 46 | fun outl (port: uint16, value: uint32):<> void = "mac#outb" 47 | 48 | fun io_wait ():<> void 49 | -------------------------------------------------------------------------------- /prelude/CATS/array.cats: -------------------------------------------------------------------------------- 1 | extern ats_void_type atspre_array_ptr_initialize_elt_tsz ( 2 | ats_ptr_type A, 3 | ats_size_type asz, 4 | ats_ptr_type ini, 5 | ats_size_type tsz 6 | ); 7 | -------------------------------------------------------------------------------- /prelude/CATS/basics.cats: -------------------------------------------------------------------------------- 1 | static inline void atspre_vbox_make_view_ptr (void *ptr) 2 | { } 3 | 4 | -------------------------------------------------------------------------------- /prelude/CATS/bool.cats: -------------------------------------------------------------------------------- 1 | #include "stdbool.h" 2 | #define atspre_oror(a,b) ((a)||(b)) 3 | #define atspre_andand(a,b) ((a)&&(b)) 4 | -------------------------------------------------------------------------------- /prelude/CATS/byte.cats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/CATS/byte.cats -------------------------------------------------------------------------------- /prelude/CATS/char.cats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/CATS/char.cats -------------------------------------------------------------------------------- /prelude/CATS/float.cats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/CATS/float.cats -------------------------------------------------------------------------------- /prelude/CATS/integer.cats: -------------------------------------------------------------------------------- 1 | #define atspre_add(a,b) ((a)+(b)) 2 | #define atspre_sub(a,b) ((a)-(b)) 3 | #define atspre_mul(a,b) ((a)*(b)) 4 | #define atspre_div(a,b) ((a)/(b)) 5 | #define atspre_mod(a,b) ((a)%(b)) 6 | #define atspre_lt(a,b) ((a)<(b)) 7 | #define atspre_gt(a,b) ((a)>(b)) 8 | #define atspre_le(a,b) ((a)<=(b)) 9 | #define atspre_ge(a,b) ((a)>=(b)) 10 | #define atspre_eq(a,b) ((a)==(b)) 11 | #define atspre_ne(a,b) ((a)!=(b)) 12 | #define atspre_shl(a,b) ((a)<<(b)) 13 | #define atspre_shr(a,b) ((a)>>(b)) 14 | #define atspre_land(a,b) ((a)&(b)) 15 | #define atspre_lor(a,b) ((a)|(b)) 16 | #define atspre_lnot(a) (~(a)) 17 | #define atspre_not(a) (!(a)) 18 | 19 | static inline bool atspre_premul_int1_int1 (int a, int b) 20 | { 21 | long r = a; 22 | int rtrunc; 23 | r *= b; 24 | rtrunc = r; 25 | return r == rtrunc; 26 | } 27 | 28 | -------------------------------------------------------------------------------- /prelude/CATS/integer_fixed.cats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/CATS/integer_fixed.cats -------------------------------------------------------------------------------- /prelude/CATS/integer_ptr.cats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/CATS/integer_ptr.cats -------------------------------------------------------------------------------- /prelude/CATS/lazy.cats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/CATS/lazy.cats -------------------------------------------------------------------------------- /prelude/CATS/lazy_vt.cats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/CATS/lazy_vt.cats -------------------------------------------------------------------------------- /prelude/CATS/list.cats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/CATS/list.cats -------------------------------------------------------------------------------- /prelude/CATS/matrix.cats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/CATS/matrix.cats -------------------------------------------------------------------------------- /prelude/CATS/option.cats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/CATS/option.cats -------------------------------------------------------------------------------- /prelude/CATS/pointer.cats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/CATS/pointer.cats -------------------------------------------------------------------------------- /prelude/CATS/printf.cats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/CATS/printf.cats -------------------------------------------------------------------------------- /prelude/CATS/reference.cats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/CATS/reference.cats -------------------------------------------------------------------------------- /prelude/CATS/sizetype.cats: -------------------------------------------------------------------------------- 1 | #include "unistd.h" 2 | -------------------------------------------------------------------------------- /prelude/CATS/string.cats: -------------------------------------------------------------------------------- 1 | #define atspre_idx_char(a,b) (((char *) (a))[(b)]) 2 | 3 | static inline int strlen (void *sp) 4 | { 5 | const char *s = sp; 6 | int len = 0; 7 | while (*s++) ++len; 8 | return len; 9 | } 10 | -------------------------------------------------------------------------------- /prelude/DATS/arith.dats: -------------------------------------------------------------------------------- 1 | implement mul_monotone (pf1, pf2) = 2 | mul_nat_nat_nat (mul_distribute2 (pf2, mul_negate pf1)) 3 | 4 | implement SHL_make {x, n} () = 5 | let 6 | prval [expn: int] pf_exp = EXP2_istot {n} () 7 | prval pf_mul = mul_istot {x, expn} () 8 | prval () = mul_nat_nat_nat pf_mul 9 | prval () = EXP2_ispos pf_exp 10 | in (pf_exp, pf_mul) end 11 | 12 | implement SHL_le {x, n1, n2, y1, y2} (pf1, pf2) = 13 | let 14 | prval (pf_exp1, pf_mul1) = pf1 15 | prval (pf_exp2, pf_mul2) = pf2 16 | prval () = EXP2_monotone (pf_exp1, pf_exp2) 17 | prval () = mul_nat_nat_nat (mul_distribute (mul_negate2 (pf_mul1), pf_mul2)) 18 | in () end 19 | 20 | implement SHL_monotone (pf1, pf2) = 21 | let 22 | prval (pf1e, pf1m) = pf1 23 | prval (pf2e, pf2m) = pf2 24 | prval () = EXP2_isfun (pf1e, pf2e) 25 | prval () = mul_nat_nat_nat (mul_distribute2 (pf2m, mul_negate pf1m)) 26 | in () end 27 | 28 | implement SHR_make {x, n} () = 29 | let 30 | prval [expn: int] (pf_exp: EXP2 (n, expn)) = EXP2_istot {n} () 31 | prval () = EXP2_ispos pf_exp 32 | prval pf_div: [y: nat] DIV (x, expn, y) = divmod_istot {x, expn} () 33 | prval () = EXP2_ispos pf_exp 34 | in (pf_exp, pf_div) end 35 | 36 | implement SHR_monotone (pf1, pf2) = 37 | let 38 | prval (pf1e, pf1d) = pf1 39 | prval (pf2e, pf2d) = pf2 40 | prval () = EXP2_isfun (pf1e, pf2e) 41 | prval () = div_monotone (pf1d, pf2d) 42 | in () end 43 | -------------------------------------------------------------------------------- /prelude/DATS/integer.dats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/DATS/integer.dats -------------------------------------------------------------------------------- /prelude/SATS/arith.sats: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* Applied Type System *) 4 | (* *) 5 | (* Hongwei Xi *) 6 | (* *) 7 | (***********************************************************************) 8 | 9 | (* 10 | ** ATS - Unleashing the Potential of Types! 11 | ** Copyright (C) 2002-2010 Hongwei Xi, Boston University 12 | ** All rights reserved 13 | ** 14 | ** ATS is free software; you can redistribute it and/or modify it under 15 | ** the terms of the GNU LESSER GENERAL PUBLIC LICENSE as published by the 16 | ** Free Software Foundation; either version 2.1, or (at your option) any 17 | ** later version. 18 | ** 19 | ** ATS is distributed in the hope that it will be useful, but WITHOUT ANY 20 | ** WARRANTY; without even the implied warranty of MERCHANTABILITY or 21 | ** FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 22 | ** for more details. 23 | ** 24 | ** You should have received a copy of the GNU General Public License 25 | ** along with ATS; see the file COPYING. If not, please write to the 26 | ** Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 27 | ** 02110-1301, USA. 28 | *) 29 | 30 | (* ****** ****** *) 31 | 32 | (* author: Hongwei Xi (hwxi AT cs DOT bu DOT edu) *) 33 | 34 | (* ****** ****** *) 35 | 36 | #include "prelude/params.hats" 37 | 38 | (* ****** ****** *) 39 | 40 | #if VERBOSE_PRELUDE #then 41 | #print "Loading [arith.sats] starts!\n" 42 | #endif // end of [VERBOSE_PRELUDE] 43 | 44 | (* ****** ****** *) 45 | 46 | dataprop MUL (int, int, int) = 47 | | {n:int} MULbas (0, n, 0) 48 | | {m,n,p:int | m >= 0} MULind (m+1, n, p+n) of MUL (m, n, p) 49 | | {m,n,p:int | m > 0} MULneg (~m, n, ~p) of MUL (m, n, p) 50 | // end of [MUL] 51 | 52 | (* ****** ****** *) 53 | 54 | praxi mul_make : {m,n:int} () - MUL (m, n, m*n) 55 | praxi mul_elim : {m,n:int} {p:int} MUL (m, n, p) - [p == m*n] void 56 | 57 | // 58 | // HX: (m+i)*n = m*n+i*n 59 | // 60 | praxi mul_add_const {i:int} 61 | {m,n:int} {p:int} (pf: MUL (m, n, p)): MUL (m+i, n, p+i*n) 62 | // end of [mul_add_const] 63 | 64 | // 65 | // HX: (ax+b)*(cy+d) = ac*xy + ad*x + bc*y + bd 66 | // 67 | praxi mul_expand_linear 68 | {a,b:int} {c,d:int} // a,b,c,d: constants! 69 | {x,y:int} {xy:int} (pf: MUL (x, y, xy)): MUL (a*x+b, c*y+d, a*c*xy+a*d*x+b*c*y+b*d) 70 | // end of [mul_expand_linear] 71 | 72 | // 73 | // HX: (a1x1+a2x2+b)*(c1y1+c2y2+d) = ... 74 | // 75 | praxi 76 | mul_expand2_linear // a1,b1,c1,a2,b2,c2: constants! 77 | {a1,a2,b:int} 78 | {c1,c2,d:int} 79 | {x1,x2:int} 80 | {y1,y2:int} 81 | {x1y1,x1y2,x2y1,x2y2:int} ( 82 | pf11: MUL (x1, y1, x1y1), pf12: MUL (x1, y2, x1y2) 83 | , pf21: MUL (x2, y1, x2y1), pf22: MUL (x2, y2, x2y2) 84 | ) : MUL ( 85 | a1*x1+a2*x2+b 86 | , c1*y1+c2*y2+d 87 | , a1*c1*x1y1 + a1*c2*x1y2 + 88 | a2*c1*x2y1 + a2*c2*x2y2 + 89 | a1*d*x1 + a2*d*x2 + 90 | b*c1*y1 + b*c2*y2 + 91 | b*d 92 | ) // end of [mul_expand2_linear] 93 | 94 | (* ****** ****** *) 95 | 96 | prfun mul_istot {m,n:int} (): [p:int] MUL (m, n, p) 97 | 98 | prfun mul_isfun {m,n:int} {p1,p2:int} 99 | (pf1: MUL (m, n, p1), pf2: MUL (m, n, p2)): [p1==p2] void 100 | 101 | (* ****** ****** *) 102 | 103 | prfun mul_nat_nat_nat : 104 | {m,n:nat} {p:int} MUL (m, n, p) - [p >= 0] void 105 | prfun mul_pos_pos_pos : 106 | {m,n:pos} {p:int} MUL (m, n, p) - [p >= m; p >= n] void 107 | 108 | (* ****** ****** *) 109 | 110 | prfun mul_negate {m,n:int} {p:int} (pf: MUL (m, n, p)): MUL (~m, n, ~p) 111 | prfun mul_negate2 {m,n:int} {p:int} (pf: MUL (m, n, p)): MUL (m, ~n, ~p) 112 | 113 | (* ****** ****** *) 114 | 115 | prfun mul_commute {m,n:int} {p:int} (pf: MUL (m, n, p)): MUL (n, m, p) 116 | 117 | (* ****** ****** *) 118 | // 119 | // HX: m*(n1+n2) = m*n1+m*n2 120 | // 121 | prfun mul_distribute {m:int} {n1,n2:int} {p1,p2:int} 122 | (pf1: MUL (m, n1, p1), pf2: MUL (m, n2, p2)): MUL (m, n1+n2, p1+p2) 123 | // 124 | // HX: (m1+m2)*n = m1*n + m2*n 125 | // 126 | prfun mul_distribute2 {m1,m2:int} {n:int} {p1,p2:int} 127 | (pf1: MUL (m1, n, p1), pf2: MUL (m2, n, p2)): MUL (m1+m2, n, p1+p2) 128 | 129 | // m1 <= m2 --> m1*n <= m2*n 130 | prfun mul_monotone 131 | {m1, m2: nat | m1 <= m2} {n: nat} {m1n, m2n: nat} 132 | (pf1: MUL (m1, n, m1n), pf2: MUL (m2, n, m2n)): 133 | [m1n <= m2n] void 134 | 135 | 136 | (* ****** ****** *) 137 | 138 | prfun 139 | mul_associate 140 | {x,y,z:int} 141 | {xy,yz,xy_z,x_yz:int} ( 142 | pf1: MUL (x, y, xy) 143 | , pf2: MUL (y, z, yz) 144 | , pf3: MUL (xy, z, xy_z) 145 | , pf4: MUL (x, yz, x_yz) 146 | ) : [xy_z==x_yz] void 147 | 148 | (* ****** ****** *) 149 | // 150 | // HX-2010-12-30: 151 | // 152 | absprop DIVMOD ( 153 | x:int, y: int, q: int, r: int // x = q * y + r 154 | ) // end of [DIVMOD] 155 | 156 | propdef DIV (x:int, y:int, q:int) = [r:int] DIVMOD (x, y, q, r) 157 | propdef MOD (x:int, y:int, r:int) = [q:int] DIVMOD (x, y, q, r) 158 | 159 | praxi div_istot {x,y:int | x >= 0; y > 0} (): DIV (x, y, x/y) 160 | 161 | praxi divmod_istot 162 | {x,y:int | x >= 0; y > 0} (): [q,r:nat | r < y] DIVMOD (x, y, q, r) 163 | 164 | praxi divmod_isfun 165 | {x,y:int | x >= 0; y > 0} 166 | {q1,q2:int} {r1,r2:int} ( 167 | pf1: DIVMOD (x, y, q1, r1) 168 | , pf2: DIVMOD (x, y, q2, r2) 169 | ) : [q1==q2;r1==r2] void // end of [divmod_isfun] 170 | 171 | praxi divmod_elim 172 | {x,y:int | x >= 0; y > 0} {q,r:int} 173 | (pf: DIVMOD (x, y, q, r)): [qy:int | 0 <= r; r < y; x==qy+r] MUL (q, y, qy) 174 | // end of [divmod_elim] 175 | 176 | praxi div_monotone 177 | {m1, m2: nat | m1 <= m2} {n: pos} {q1, r1, q2, r2: int} 178 | (pf1: DIVMOD (m1, n, q1, r1), pf2: DIVMOD (m2, n, q2, r2)): 179 | [q1 <= q2] void 180 | 181 | (* ****** ****** *) 182 | 183 | (* 184 | dataprop GCD (int, int, int) = 185 | | {m:nat} GCDbas1 (m, 0, m) 186 | | {n:pos} GCDbas2 (0, n, n) 187 | | {m:pos;n:int | m <= n} {r:int} GCDind1 (m, n, r) of GCD (m, n-m, r) 188 | | {m:int;n:pos | m > n } {r:int} GCDind2 (m, n, r) of GCD (m-n, n, r) 189 | | {m:nat;n:int | n < 0} {r:int} GCDneg1 (m, n, r) of GCD (m, ~n, r) 190 | | {m:int;n:int | m < 0} {r:int} GCDneg2 (m, n, r) of GCD (~m, n, r) 191 | // end of [GCD] 192 | *) 193 | 194 | // 195 | // HX-2010-12-31: GCD (0, 0, 0): gcd (0, 0) = 0 196 | // 197 | absprop GCD (int, int, int) 198 | 199 | prfun gcd_istot {m,n:int} (): [r:nat] GCD (m,n,r) 200 | prfun gcd_isfun {m,n:int} {r1,r2:int} 201 | (pf1: GCD (m, n, r1), pf2: GCD (m, n, r2)): [r1==r2] void 202 | 203 | prfun gcd_commute {m,n:int} {r:int} (pf: GCD (m, n, r)): GCD (n, m, r) 204 | 205 | (* ****** ****** *) 206 | 207 | dataprop EXP2 (int, int) = 208 | | {n:nat} {p:nat} EXP2ind (n+1, 2*p) of EXP2 (n, p) 209 | | EXP2bas (0, 1) 210 | // end of [EXP2] 211 | 212 | // 213 | // HX: proven in [arith.dats] 214 | // 215 | prfun EXP2_istot {n:nat} (): [p:nat] EXP2 (n, p) 216 | prfun EXP2_isfun {n:nat} {p1,p2:int} 217 | (pf1: EXP2 (n, p1), pf2: EXP2 (n, p2)): [p1==p2] void 218 | // end of [EXP2_isfun] 219 | 220 | // 221 | // HX: proven in [arith.dats] 222 | // 223 | prfun EXP2_ispos 224 | {n:nat} {p:int} (pf: EXP2 (n, p)): [p >= 1] void 225 | // end of [EXP2_ispos] 226 | 227 | // 228 | // HX: proven in [arith.dats] 229 | // 230 | prfun EXP2_monotone 231 | {n1,n2:nat | n1 <= n2} {p1,p2:int} 232 | (pf1: EXP2 (n1, p1), pf2: EXP2 (n2, p2)): [p1 <= p2] void 233 | // end of [EXP2_monotone] 234 | 235 | // 236 | // HX: proven in [arith.dats] 237 | // 238 | prfun EXP2_mul 239 | {n1,n2:nat | n1 <= n2} {p1,p2:nat} {p:int} ( 240 | pf1: EXP2 (n1, p1), pf2: EXP2 (n2, p2), pf3: MUL (p1, p2, p) 241 | ) : EXP2 (n1+n2, p) // end of [EXP2_mul] 242 | 243 | (* ****** ****** *) 244 | 245 | // x << n == x * 2**n == y 246 | propdef SHL (x: int, n: int, y: int) = 247 | [expn: pos] [y >= 0] (EXP2 (n, expn), MUL (x, expn, y)) 248 | 249 | prfun SHL_make {x, n: nat} (): [y: nat] SHL (x, n, y) 250 | 251 | // n1 <= n2 --> (x << n1) <= (x << n2) 252 | prfun SHL_le 253 | {x, n1, n2, y1, y2: nat | n1 <= n2} 254 | (pf1: SHL (x, n1, y1), pf2: SHL (x, n2, y2)): 255 | [y1 <= y2] void 256 | 257 | // x <= y --> (x << n) <= (y << n) 258 | prfun SHL_monotone {x, y, n, xn, yn: nat | x <= y} 259 | (pf1: SHL (x, n, xn), pf2: SHL (y, n, yn)): 260 | [xn <= yn] void 261 | 262 | // x >> n == x / 2**n == y 263 | propdef SHR (x: int, n: int, y: int) = 264 | [expn: pos] [y >= 0] (EXP2 (n, expn), DIV (x, expn, y)) 265 | 266 | prfun SHR_make {x, n: nat} (): [y: nat] SHR (x, n, y) 267 | 268 | // x <= y --> (x >> n) <= (y >> n) 269 | prfun SHR_monotone {x, y, n, xn, yn: nat | x <= y} 270 | (pf1: SHR (x, n, xn), pf2: SHR (y, n, yn)): 271 | [xn <= yn] void 272 | 273 | 274 | (* ****** ****** *) 275 | 276 | // Calculate 2**n 277 | macrodef rec exp2 n = 278 | if n > 0 then `(2 * ,(exp2 (n-1))) else `(1) 279 | 280 | // Construct a proof of MUL (m, n, mn) 281 | macrodef rec pf_mul_const n = 282 | if n > 0 then `(MULind (,(pf_mul_const (n-1)))) else `(MULbas ()) 283 | 284 | // Construct a proof of EXP2 (n, x) 285 | // e.g. ,(pf_exp2_const 16) will produce EXP2 (16, 65536). 286 | macrodef rec pf_exp2_const n = 287 | if n > 0 then `(EXP2ind (,(pf_exp2_const (n-1)))) else `(EXP2bas ()) 288 | 289 | macrodef pf_shl_const x n = 290 | `( ( ,(pf_exp2_const n), ,(pf_mul_const x) ) ) 291 | 292 | 293 | (* end of [arith.sats] *) 294 | -------------------------------------------------------------------------------- /prelude/SATS/array.sats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/SATS/array.sats -------------------------------------------------------------------------------- /prelude/SATS/array0.sats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/SATS/array0.sats -------------------------------------------------------------------------------- /prelude/SATS/bool.sats: -------------------------------------------------------------------------------- 1 | fun neg_bool (a: bool):<> bool = "mac#atspre_not" 2 | fun add_bool_bool (a: bool, b: bool):<> bool = "mac#atspre_oror" 3 | fun mul_bool_bool (a: bool, b: bool):<> bool = "mac#atspre_andand" 4 | overload not with neg_bool 5 | overload || with add_bool_bool 6 | overload && with mul_bool_bool 7 | 8 | fun neg_bool1 9 | {a: bool} (a: bool a):<> bool (~a) 10 | = "mac#atspre_not" 11 | overload not with neg_bool1 12 | 13 | fun add_bool1_bool1 14 | {a, b: bool} (a: bool a, b: bool b):<> bool (a || b) 15 | = "mac#atspre_oror" 16 | 17 | fun mul_bool1_bool1 18 | {a, b: bool} (a: bool a, b: bool b):<> bool (a && b) 19 | = "mac#atspre_andand" 20 | overload || with add_bool1_bool1 21 | overload && with mul_bool1_bool1 22 | -------------------------------------------------------------------------------- /prelude/SATS/byte.sats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/SATS/byte.sats -------------------------------------------------------------------------------- /prelude/SATS/char.sats: -------------------------------------------------------------------------------- 1 | fun eq_char1_char1 {a, b: char} 2 | (a: char a, b: char b):<> bool (a == b) 3 | = "mac#atspre_eq" 4 | overload = with eq_char1_char1 5 | 6 | castfn ubyte_of_char (a: char):<> ubyte 7 | overload ubyte_of with ubyte_of_char 8 | -------------------------------------------------------------------------------- /prelude/SATS/dlist_vt.sats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/SATS/dlist_vt.sats -------------------------------------------------------------------------------- /prelude/SATS/extern.sats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/SATS/extern.sats -------------------------------------------------------------------------------- /prelude/SATS/filebas.sats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/SATS/filebas.sats -------------------------------------------------------------------------------- /prelude/SATS/float.sats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/SATS/float.sats -------------------------------------------------------------------------------- /prelude/SATS/integer_fixed.sats: -------------------------------------------------------------------------------- 1 | // This defines fixed-width integer types. 2 | // Warning: Architecture dependent! 3 | staload "prelude/limits.sats" 4 | 5 | stadef uint8 = ubyte 6 | stadef uint16 = ushort 7 | stadef uint32 = uint 8 | stadef uint64 = uint_llong_t0ype 9 | 10 | stadef uint8 = ubyte_int_t0ype 11 | stadef uint16 = uint_short_int_t0ype 12 | stadef uint32 = uint_int_t0ype 13 | stadef uint64 = uint_llong_int_t0ype 14 | 15 | overload uint8_of with ubyte_of_ubyte1 16 | overload uint8_of with ubyte_of_ushort1 17 | overload uint8_of with ubyte_of_uint1 18 | overload uint8_of with ubyte_of_ulong1 19 | overload uint8_of with ubyte_of_byte1 20 | overload uint8_of with ubyte_of_short1 21 | overload uint8_of with ubyte_of_int1 22 | overload uint8_of with ubyte_of_long1 23 | overload uint8_1_of with ubyte1_of_ubyte 24 | overload uint8_1_of with ubyte1_of_ushort1 25 | overload uint8_1_of with ubyte1_of_uint1 26 | overload uint8_1_of with ubyte1_of_ulong1 27 | overload uint8_1_of with ubyte1_of_byte1 28 | overload uint8_1_of with ubyte1_of_short1 29 | overload uint8_1_of with ubyte1_of_int1 30 | overload uint8_1_of with ubyte1_of_long1 31 | 32 | overload uint16_of with ushort_of_ubyte1 33 | overload uint16_of with ushort_of_ushort1 34 | overload uint16_of with ushort_of_uint1 35 | overload uint16_of with ushort_of_ulong1 36 | overload uint16_of with ushort_of_byte1 37 | overload uint16_of with ushort_of_short1 38 | overload uint16_of with ushort_of_int1 39 | overload uint16_of with ushort_of_long1 40 | overload uint16_1_of with ushort1_of_ubyte1 41 | overload uint16_1_of with ushort1_of_ushort 42 | overload uint16_1_of with ushort1_of_uint1 43 | overload uint16_1_of with ushort1_of_ulong1 44 | overload uint16_1_of with ushort1_of_byte1 45 | overload uint16_1_of with ushort1_of_short1 46 | overload uint16_1_of with ushort1_of_int1 47 | overload uint16_1_of with ushort1_of_long1 48 | 49 | overload uint32_of with uint_of_ubyte1 50 | overload uint32_of with uint_of_ushort1 51 | overload uint32_of with uint_of_uint1 52 | overload uint32_of with uint_of_ulong1 53 | overload uint32_of with uint_of_byte1 54 | overload uint32_of with uint_of_short1 55 | overload uint32_of with uint_of_int1 56 | overload uint32_of with uint_of_long1 57 | overload uint32_1_of with uint1_of_ubyte1 58 | overload uint32_1_of with uint1_of_ushort1 59 | overload uint32_1_of with uint1_of_uint 60 | overload uint32_1_of with uint1_of_ulong1 61 | overload uint32_1_of with uint1_of_byte1 62 | overload uint32_1_of with uint1_of_short1 63 | overload uint32_1_of with uint1_of_int1 64 | overload uint32_1_of with uint1_of_long1 65 | 66 | overload uint64_of with ullong_of_ubyte1 67 | overload uint64_of with ullong_of_ushort1 68 | overload uint64_of with ullong_of_uint1 69 | overload uint64_of with ullong_of_ulong1 70 | overload uint64_of with ullong_of_byte1 71 | overload uint64_of with ullong_of_short1 72 | overload uint64_of with ullong_of_int1 73 | overload uint64_of with ullong_of_long1 74 | overload uint64_1_of with ullong1_of_ubyte1 75 | overload uint64_1_of with ullong1_of_ushort1 76 | overload uint64_1_of with ullong1_of_uint1 77 | overload uint64_1_of with ullong1_of_ulong1 78 | overload uint64_1_of with ullong1_of_byte1 79 | overload uint64_1_of with ullong1_of_short1 80 | overload uint64_1_of with ullong1_of_int1 81 | overload uint64_1_of with ullong1_of_long1 82 | -------------------------------------------------------------------------------- /prelude/SATS/integer_ptr.sats: -------------------------------------------------------------------------------- 1 | symintr uintptr_of uintptr1_of 2 | 3 | castfn uintptr_of_ptr (p: ptr):<> uintptr_t 4 | castfn uintptr_of_ptr1 {l: addr} (p: ptr l):<> uintptr_t 5 | castfn uintptr1_of_ptr (p: ptr):<> [x: Uintptr] uintptr_t x 6 | castfn uintptr1_of_ptr1 {l: addr} (p: ptr l):<> [x: Uintptr] uintptr_t x 7 | castfn uintptr_of_uint1 {x: Uintptr} (x: uint x):<> uintptr_t 8 | castfn uintptr1_of_uint1 {x: Uintptr} (x: uint x):<> uintptr_t x 9 | castfn uint1_of_uintptr1 {x: Uint} (x: uintptr_t x):<> uint x 10 | 11 | overload uintptr_of with uintptr_of_ptr 12 | overload uintptr_of with uintptr_of_ptr1 13 | overload uintptr_of with uintptr_of_uint1 14 | overload uintptr1_of with uintptr1_of_ptr 15 | overload uintptr1_of with uintptr1_of_ptr1 16 | overload uintptr1_of with uintptr1_of_uint1 17 | overload uint1_of with uint1_of_uintptr1 18 | 19 | fun land_uintptr_uintptr 20 | (a: uintptr_t, b: uintptr_t):<> 21 | uintptr_t = "mac#atspre_land" 22 | 23 | fun lor_uintptr_uintptr 24 | (a: uintptr_t, b: uintptr_t):<> 25 | uintptr_t = "mac#atspre_lor" 26 | 27 | fun shr_uintptr_int (a: uintptr_t, n: Int):<> 28 | uintptr_t = "mac#atspre_shr" 29 | 30 | fun land_uintptr1_uintptr1 31 | {a, b: Uintptr} 32 | (a: uintptr_t a, b: uintptr_t b):<> 33 | [c: Uintptr | c <= a && c <= b] 34 | uintptr_t c = "mac#atspre_land" 35 | 36 | fun lor_uintptr1_uintptr1 37 | {a, b: Uintptr} 38 | (a: uintptr_t a, b: uintptr_t b):<> 39 | [c: Uintptr | c >= a && c >= b && c <= a + b] 40 | uintptr_t c = "mac#atspre_lor" 41 | 42 | fun shr_uintptr1_int1 43 | {a: Uintptr} {n: nat} 44 | (a: uintptr_t a, n: int n):<> 45 | [r: Uintptr] uintptr_t r = "mac#atspre_shr" 46 | 47 | overload land with land_uintptr_uintptr 48 | overload lor with lor_uintptr_uintptr 49 | overload >> with shr_uintptr_int 50 | overload land with land_uintptr1_uintptr1 51 | overload lor with lor_uintptr1_uintptr1 52 | overload >> with shr_uintptr1_int1 53 | -------------------------------------------------------------------------------- /prelude/SATS/lazy.sats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/SATS/lazy.sats -------------------------------------------------------------------------------- /prelude/SATS/lazy_vt.sats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/SATS/lazy_vt.sats -------------------------------------------------------------------------------- /prelude/SATS/list.sats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/SATS/list.sats -------------------------------------------------------------------------------- /prelude/SATS/list0.sats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/SATS/list0.sats -------------------------------------------------------------------------------- /prelude/SATS/list_vt.sats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/SATS/list_vt.sats -------------------------------------------------------------------------------- /prelude/SATS/matrix.sats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/SATS/matrix.sats -------------------------------------------------------------------------------- /prelude/SATS/matrix0.sats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/SATS/matrix0.sats -------------------------------------------------------------------------------- /prelude/SATS/memory.sats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/SATS/memory.sats -------------------------------------------------------------------------------- /prelude/SATS/option.sats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/SATS/option.sats -------------------------------------------------------------------------------- /prelude/SATS/option0.sats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/SATS/option0.sats -------------------------------------------------------------------------------- /prelude/SATS/option_vt.sats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/SATS/option_vt.sats -------------------------------------------------------------------------------- /prelude/SATS/pointer.sats: -------------------------------------------------------------------------------- 1 | fun eq_ptr_ptr (a: ptr, b: ptr):<> bool = "mac#atspre_eq" 2 | fun ne_ptr_ptr (a: ptr, b: ptr):<> bool = "mac#atspre_ne" 3 | fun lt_ptr_ptr (a: ptr, b: ptr):<> bool = "mac#atspre_lt" 4 | fun gt_ptr_ptr (a: ptr, b: ptr):<> bool = "mac#atspre_gt" 5 | fun le_ptr_ptr (a: ptr, b: ptr):<> bool = "mac#atspre_le" 6 | fun ge_ptr_ptr (a: ptr, b: ptr):<> bool = "mac#atspre_ge" 7 | overload = with eq_ptr_ptr 8 | overload != with ne_ptr_ptr 9 | overload < with lt_ptr_ptr 10 | overload > with gt_ptr_ptr 11 | overload <= with le_ptr_ptr 12 | overload >= with ge_ptr_ptr 13 | 14 | fun eq_ptr1_ptr1 {a, b: addr} (a: ptr a, b: ptr b):<> bool (a == b) = "mac#atspre_eq" 15 | fun ne_ptr1_ptr1 {a, b: addr} (a: ptr a, b: ptr b):<> bool (a <> b) = "mac#atspre_ne" 16 | fun lt_ptr1_ptr1 {a, b: addr} (a: ptr a, b: ptr b):<> bool (a < b) = "mac#atspre_lt" 17 | fun gt_ptr1_ptr1 {a, b: addr} (a: ptr a, b: ptr b):<> bool (a > b) = "mac#atspre_gt" 18 | fun le_ptr1_ptr1 {a, b: addr} (a: ptr a, b: ptr b):<> bool (a <= b) = "mac#atspre_le" 19 | fun ge_ptr1_ptr1 {a, b: addr} (a: ptr a, b: ptr b):<> bool (a >= b) = "mac#atspre_ge" 20 | overload = with eq_ptr1_ptr1 21 | overload != with ne_ptr1_ptr1 22 | overload < with lt_ptr1_ptr1 23 | overload > with gt_ptr1_ptr1 24 | overload <= with le_ptr1_ptr1 25 | overload >= with ge_ptr1_ptr1 26 | -------------------------------------------------------------------------------- /prelude/SATS/printf.sats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/SATS/printf.sats -------------------------------------------------------------------------------- /prelude/SATS/ptrarr.sats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/SATS/ptrarr.sats -------------------------------------------------------------------------------- /prelude/SATS/reference.sats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/SATS/reference.sats -------------------------------------------------------------------------------- /prelude/SATS/sizetype.sats: -------------------------------------------------------------------------------- 1 | symintr size1_of 2 | 3 | castfn int1_of_size1 {x: Int} (x: size_t x):<> int x 4 | overload int1_of with int1_of_size1 5 | 6 | castfn size1_of_int1 {x: Size} (x: int x):<> size_t x 7 | overload size1_of with size1_of_int1 8 | 9 | fun eq_size1_size1 10 | {a, b: int} (a: size_t a, b: size_t b):<> 11 | bool (a == b) = "mac#atspre_eq" 12 | fun ne_size1_size1 13 | {a, b: int} (a: size_t a, b: size_t b):<> 14 | bool (a <> b) = "mac#atspre_ne" 15 | fun lt_size1_size1 16 | {a, b: int} (a: size_t a, b: size_t b):<> 17 | bool (a < b) = "mac#atspre_lt" 18 | fun gt_size1_size1 19 | {a, b: int} (a: size_t a, b: size_t b):<> 20 | bool (a > b) = "mac#atspre_gt" 21 | fun le_size1_size1 22 | {a, b: int} (a: size_t a, b: size_t b):<> 23 | bool (a <= b) = "mac#atspre_le" 24 | fun ge_size1_size1 25 | {a, b: int} (a: size_t a, b: size_t b):<> 26 | bool (a >= b) = "mac#atspre_ge" 27 | overload = with eq_size1_size1 28 | overload != with ne_size1_size1 29 | overload < with lt_size1_size1 30 | overload > with gt_size1_size1 31 | overload <= with le_size1_size1 32 | overload >= with ge_size1_size1 33 | -------------------------------------------------------------------------------- /prelude/SATS/string.sats: -------------------------------------------------------------------------------- 1 | stadef NUL = '\0' 2 | sortdef cgz = {c: char | c <> NUL} 3 | typedef c1har = [ch: cgz] char ch 4 | 5 | fun idx_string_int 6 | {len: Nat} {i: Nat | i < len} 7 | (s: string len, i: int i):<> c1har 8 | = "mac#atspre_idx_char" 9 | overload [] with idx_string_int 10 | 11 | fun string_length {len: nat} 12 | (s: string len):<> 13 | [len': Nat | len == len'] int len 14 | = "strlen" 15 | 16 | castfn string1_of_string 17 | (s: string):<> [len: Nat] string len 18 | -------------------------------------------------------------------------------- /prelude/SATS/vsubrw.sats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/SATS/vsubrw.sats -------------------------------------------------------------------------------- /prelude/basics_dyn.sats: -------------------------------------------------------------------------------- 1 | (* Required by compiler. *) 2 | fun main_void (): void 3 | fun main_argc_argv {n: igz} 4 | (argc: int n, argv: &(@[ptr][n])): void 5 | prfun main_dummy (): void 6 | 7 | symintr byte_of ubyte_of byte1_of ubyte1_of 8 | symintr short_of ushort_of short1_of ushort1_of 9 | symintr int_of uint_of int1_of uint1_of 10 | symintr long_of ulong_of long1_of ulong1_of 11 | symintr llong_of ullong_of llong1_of ullong1_of 12 | symintr uint8_of uint16_of uint32_of uint64_of 13 | symintr uint8_1_of uint16_1_of uint32_1_of uint64_1_of 14 | symintr + - * / mod gcd 15 | symintr < > <= >= = != 16 | symintr && || << >> land lor not ~ 17 | symintr *? 18 | infixl ( * ) *? 19 | 20 | val true: bool true = "mac#true" 21 | val false: bool false = "mac#false" 22 | 23 | val {T: viewt@ype} sizeof: size_t (sizeof T) 24 | 25 | (* "opt" is a box for storing a possibly initialised viewtype. *) 26 | praxi opt_some {vt:viewt@ype} (x: !vt >> opt(vt,true)):<> void 27 | praxi opt_none {vt:viewt@ype} (x: !vt? >> opt(vt,false)):<> void 28 | praxi opt_unsome {vt:viewt@ype} (x: !opt(vt,true) >> vt):<> void 29 | praxi opt_unnone {vt:viewt@ype} (x: !opt(vt,false) >> vt?):<> void 30 | 31 | // Only for globals. 32 | fun vbox_make_view_ptr 33 | {vt:viewt@ype} {l:addr} 34 | (pf: vt @ l | p: ptr l): (vbox (vt @ l) | void) 35 | = "atspre_vbox_make_view_ptr" 36 | -------------------------------------------------------------------------------- /prelude/basics_sta.sats: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* Applied Type System *) 4 | (* *) 5 | (* Hongwei Xi *) 6 | (* *) 7 | (***********************************************************************) 8 | 9 | (* 10 | ** ATS - Unleashing the Potential of Types! 11 | ** Copyright (C) 2002-2010 Hongwei Xi, Boston University 12 | ** All rights reserved 13 | ** 14 | ** ATS is free software; you can redistribute it and/or modify it under 15 | ** the terms of the GNU LESSER GENERAL PUBLIC LICENSE as published by the 16 | ** Free Software Foundation; either version 2.1, or (at your option) any 17 | ** later version. 18 | ** 19 | ** ATS is distributed in the hope that it will be useful, but WITHOUT ANY 20 | ** WARRANTY; without even the implied warranty of MERCHANTABILITY or 21 | ** FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 22 | ** for more details. 23 | ** 24 | ** You should have received a copy of the GNU General Public License 25 | ** along with ATS; see the file COPYING. If not, please write to the 26 | ** Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 27 | ** 02110-1301, USA. 28 | *) 29 | 30 | (* ****** ****** *) 31 | // 32 | // Author of the file: Hongwei Xi (hwxi AT cs DOT bu DOT edu) 33 | // Start Time: 2007 34 | // Edited in 2012 by Joshua Phillips 35 | // 36 | (* ****** ****** *) 37 | 38 | 39 | (* Mandatory, "pervasive" declarations required by compiler. *) 40 | 41 | abst@ype void_t0ype = $extype "ats_void_type" 42 | 43 | abst@ype bool_t0ype = $extype "bool" 44 | abst@ype char_t0ype = $extype "char" 45 | abst@ype byte_t0ype = $extype "schar" 46 | abst@ype ubyte_t0ype = $extype "uchar" 47 | abst@ype int_t0ype = $extype "int" 48 | abst@ype uint_t0ype = $extype "uint" 49 | abst@ype int_short_t0ype = $extype "short" 50 | abst@ype uint_short_t0ype = $extype "ushort" 51 | abst@ype int_long_t0ype = $extype "long" 52 | abst@ype uint_long_t0ype = $extype "ulong" 53 | abst@ype int_llong_t0ype = $extype "llong" 54 | abst@ype uint_llong_t0ype = $extype "ullong" 55 | abst@ype size_t0ype = $extype "size_t" 56 | abst@ype ssize_t0ype = $extype "ssize_t" 57 | abst@ype intptr_t0ype = $extype "intptr_t" 58 | abst@ype uintptr_t0ype = $extype "uintptr_t" 59 | abstype ptr_type = $extype "ptr" 60 | 61 | abst@ype bool_bool_t0ype (bool) = bool_t0ype 62 | abst@ype char_char_t0ype (char) = char_t0ype 63 | abst@ype byte_int_t0ype (int) = byte_t0ype 64 | abst@ype ubyte_int_t0ype (int) = ubyte_t0ype 65 | abst@ype int_int_t0ype (int) = int_t0ype 66 | abst@ype uint_int_t0ype (int) = uint_t0ype 67 | abst@ype int_short_int_t0ype (int) = int_short_t0ype 68 | abst@ype uint_short_int_t0ype (int) = uint_short_t0ype 69 | abst@ype lint_int_t0ype (int) = int_long_t0ype 70 | abst@ype ulint_int_t0ype (int) = uint_long_t0ype 71 | abst@ype int_llong_int_t0ype (int) = int_llong_t0ype 72 | abst@ype uint_llong_int_t0ype (int) = uint_llong_t0ype 73 | abst@ype size_int_t0ype (int) = size_t0ype 74 | abst@ype ssize_int_t0ype (int) = ssize_t0ype 75 | abst@ype intptr_int_t0ype (int) = intptr_t0ype 76 | abst@ype uintptr_int_t0ype (int) = uintptr_t0ype 77 | abstype ptr_addr_type (addr) = ptr_type 78 | 79 | abstype string_type 80 | abstype string_int_type (int) 81 | abst@ype strbuf_t0ype 82 | abst@ype strbuf_int_int_t0ype (int, int) 83 | 84 | absviewt@ype clo_viewt0ype_viewt0ype (viewt@ype+) 85 | absviewtype cloptr_viewt0ype_viewtype (viewt@ype+) 86 | abstype cloref_t0ype_type (t@ype) 87 | absviewt@ype crypt_viewt0ype_viewt0ype (a: viewt@ype) = a 88 | 89 | absview at_viewt0ype_addr_view (viewt@ype+, addr) 90 | absprop vbox_view_prop (view) 91 | 92 | stacst true_bool : bool and false_bool : bool 93 | stacst neg_bool_bool : bool -> bool (* boolean negation *) 94 | stacst mul_bool_bool_bool : (bool, bool) -> bool (* conjunction *) 95 | stacst add_bool_bool_bool : (bool, bool) -> bool (* disjunction *) 96 | stacst gt_bool_bool_bool : (bool, bool) -> bool 97 | stacst gte_bool_bool_bool : (bool, bool) -> bool 98 | stacst lt_bool_bool_bool : (bool, bool) -> bool 99 | stacst lte_bool_bool_bool : (bool, bool) -> bool 100 | stacst eq_bool_bool_bool : (bool, bool) -> bool 101 | stacst neq_bool_bool_bool : (bool, bool) -> bool 102 | 103 | stacst sub_char_char_int : (char, char) -> int 104 | stacst gt_char_char_bool : (char, char) -> bool 105 | stacst gte_char_char_bool : (char, char) -> bool 106 | stacst lt_char_char_bool : (char, char) -> bool 107 | stacst lte_char_char_bool : (char, char) -> bool 108 | stacst eq_char_char_bool : (char, char) -> bool 109 | stacst neq_char_char_bool : (char, char) -> bool 110 | 111 | stacst neg_int_int : int -> int (* integer negation *) 112 | stacst add_int_int_int : (int, int) -> int (* addition *) 113 | stacst sub_int_int_int: (int, int) -> int (* subtraction *) 114 | stacst nsub_int_int_int: (int, int) -> int (* subtraction on nats *) 115 | stacst mul_int_int_int : (int, int) -> int (* multiplication *) 116 | stacst div_int_int_int : (int, int) -> int (* division *) 117 | stadef / = div_int_int_int 118 | stacst gt_int_int_bool : (int, int) -> bool 119 | stacst gte_int_int_bool : (int, int) -> bool 120 | stacst lt_int_int_bool : (int, int) -> bool 121 | stacst lte_int_int_bool : (int, int) -> bool 122 | stacst eq_int_int_bool : (int, int) -> bool 123 | stacst neq_int_int_bool : (int, int) -> bool 124 | 125 | stacst null_addr : addr 126 | stacst add_addr_int_addr : (addr, int) -> addr 127 | stacst sub_addr_int_addr : (addr, int) -> addr 128 | stacst sub_addr_addr_int : (addr, addr) -> int 129 | stacst gt_addr_addr_bool : (addr, addr) -> bool 130 | stacst gte_addr_addr_bool : (addr, addr) -> bool 131 | stacst lt_addr_addr_bool : (addr, addr) -> bool 132 | stacst lte_addr_addr_bool : (addr, addr) -> bool 133 | stacst eq_addr_addr_bool : (addr, addr) -> bool 134 | stacst neq_addr_addr_bool : (addr, addr) -> bool 135 | 136 | stacst lte_cls_cls_bool : (cls, cls) -> bool 137 | 138 | (* Short names. *) 139 | stadef void = void_t0ype 140 | stadef bool = bool_t0ype 141 | stadef char = char_t0ype 142 | stadef byte = byte_t0ype 143 | stadef ubyte = ubyte_t0ype 144 | stadef int = int_t0ype 145 | stadef uint = uint_t0ype 146 | stadef short = int_short_t0ype 147 | stadef ushort = uint_short_t0ype 148 | stadef long = int_long_t0ype 149 | stadef ulong = uint_long_t0ype 150 | stadef llong = int_llong_t0ype 151 | stadef ullong = uint_llong_t0ype 152 | stadef size_t = size_t0ype 153 | stadef ssize_t = ssize_t0ype 154 | stadef intptr_t = intptr_t0ype 155 | stadef uintptr_t = uintptr_t0ype 156 | stadef ptr = ptr_type 157 | stadef bool = bool_bool_t0ype 158 | stadef char = char_char_t0ype 159 | stadef byte = byte_int_t0ype 160 | stadef ubyte = ubyte_int_t0ype 161 | stadef int = int_int_t0ype 162 | stadef uint = uint_int_t0ype 163 | stadef short = int_short_int_t0ype 164 | stadef ushort = uint_short_int_t0ype 165 | stadef long = lint_int_t0ype 166 | stadef ulong = ulint_int_t0ype 167 | stadef llong = int_llong_int_t0ype 168 | stadef ullong = uint_llong_int_t0ype 169 | stadef size_t = size_int_t0ype 170 | stadef ssize_t = ssize_int_t0ype 171 | stadef uintptr_t = uintptr_int_t0ype 172 | stadef ptr = ptr_addr_type 173 | stadef string = string_type 174 | stadef string = string_int_type 175 | 176 | stadef @ = at_viewt0ype_addr_view 177 | stadef vbox = vbox_view_prop 178 | 179 | stadef true = true_bool and false = false_bool 180 | stadef ~ = neg_bool_bool 181 | stadef && = mul_bool_bool_bool 182 | stadef || = add_bool_bool_bool 183 | stadef > = gt_bool_bool_bool 184 | stadef >= = gte_bool_bool_bool 185 | stadef < = lt_bool_bool_bool 186 | stadef <= = lte_bool_bool_bool 187 | stadef == = eq_bool_bool_bool 188 | stadef <> = neq_bool_bool_bool 189 | 190 | stadef - = sub_char_char_int 191 | stadef > = gt_char_char_bool 192 | stadef >= = gte_char_char_bool 193 | stadef < = lt_char_char_bool 194 | stadef <= = lte_char_char_bool 195 | stadef == = eq_char_char_bool 196 | stadef <> = neq_char_char_bool 197 | 198 | stadef ~ = neg_int_int 199 | stadef + = add_int_int_int 200 | stadef - = sub_int_int_int 201 | stadef nsub = nsub_int_int_int 202 | stadef * = mul_int_int_int 203 | stadef > = gt_int_int_bool 204 | stadef >= = gte_int_int_bool 205 | stadef < = lt_int_int_bool 206 | stadef <= = lte_int_int_bool 207 | stadef == = eq_int_int_bool 208 | stadef <> = neq_int_int_bool 209 | 210 | stadef + = add_addr_int_addr 211 | stadef - = sub_addr_int_addr 212 | stadef - = sub_addr_addr_int 213 | stadef > = gt_addr_addr_bool 214 | stadef >= = gte_addr_addr_bool 215 | stadef < = lt_addr_addr_bool 216 | stadef <= = lte_addr_addr_bool 217 | stadef == = eq_addr_addr_bool 218 | stadef <> = neq_addr_addr_bool 219 | 220 | stadef null = null_addr 221 | 222 | (* Quantified types. *) 223 | 224 | typedef Ptr = [l: addr] ptr l 225 | 226 | (* ****** ****** *) 227 | 228 | // abst@ype uint8 = $extype "uint8_t" 229 | // abst@ype uint16 = $extype "uint16_t" 230 | // abst@ype uint32 = $extype "uint32_t" 231 | 232 | 233 | (* ****** ****** *) 234 | // 235 | // HX: The following definitions are needed in the ATS constraint solver 236 | // 237 | // absolute value function relation 238 | // 239 | stadef abs_int_int_bool (x: int, v: int): bool = 240 | (x >= 0 && x == v) || (x <= 0 && ~x == v) 241 | stadef abs_r = abs_int_int_bool 242 | // 243 | // HX: in-between relation 244 | // 245 | stadef btw_int_int_int_bool (x: int, y: int, z:int): bool = 246 | (x <= y && y < z) 247 | // 248 | // HX: int_of_bool conversion 249 | // 250 | stadef int_of_bool_bool (b: bool, v: int): bool = 251 | (b && v == 1) || (~b && v == 0) 252 | // 253 | // HX: subtraction relation on natural numbers 254 | // 255 | stadef nsub_int_int_int_bool (x: int, y: int, v: int): bool = 256 | (x >= y && v == x - y) || (x <= y && v == 0) 257 | stadef nsub_r = nsub_int_int_int_bool 258 | // 259 | // HX: maximum function relation 260 | // 261 | stadef max_int_int_int_bool (x: int, y: int, v: int): bool = 262 | (x >= y && x == v) || (x <= y && y == v) 263 | stadef max_r = max_int_int_int_bool 264 | // 265 | // HX: minimum function relation 266 | // 267 | stadef min_int_int_int_bool (x: int, y: int, v: int): bool = 268 | (x >= y && y == v) || (x <= y && x == v) 269 | stadef min_r = min_int_int_int_bool 270 | // 271 | // HX: sign function relation 272 | // 273 | stadef sgn_int_int_bool (x: int, v: int): bool = 274 | (x > 0 && v == 1) || (x == 0 && v == 0) || (x < 0 && v == ~1) 275 | stadef sgn_r = sgn_int_int_bool 276 | // 277 | // HX: division relation (nat) 278 | // 279 | stadef ndiv_int_int_int_bool (x: int, y: int, q: int): bool = 280 | (q * y <= x && x < q * y + y) 281 | stadef ndiv_r = ndiv_int_int_int_bool 282 | // 283 | // HX: division relation (int) 284 | // 285 | stadef div_int_int_int_bool (x: int, y: int, q: int) = 286 | (x >= 0 && y > 0 && ndiv_int_int_int_bool (x, y, q)) || 287 | (x >= 0 && y < 0 && ndiv_int_int_int_bool (x, ~y, ~q)) || 288 | (x <= 0 && y > 0 && ndiv_int_int_int_bool (~x, y, ~q)) || 289 | (x <= 0 && y < 0 && ndiv_int_int_int_bool (~x, ~y, q)) 290 | stadef div_r = div_int_int_int_bool 291 | // 292 | // HX: modulo relation // not handled yet 293 | // 294 | (* ****** ****** *) 295 | 296 | stadef 297 | size_int_int_bool 298 | (sz:int, n:int) = n >= 0 299 | stacst sizeof_viewt0ype_int : viewt@ype -> int 300 | stadef sizeof = sizeof_viewt0ype_int 301 | 302 | (********** Views/helpful types/etc. **********) 303 | 304 | absviewt@ype opt (vt:viewt@ype+, opt:bool) = vt 305 | 306 | prfun static_assert {b: bool | b == true} (): void // = () 307 | 308 | dataview choice_v (b:bool, true_v:view+, false_v:view+) = 309 | | True_v (true, true_v, false_v) of true_v 310 | | False_v (false, true_v, false_v) of false_v 311 | 312 | dataview option_v (v:view+, b:bool) = 313 | | Some_v (v, true) of v 314 | | None_v (v, false) 315 | 316 | dataviewtype option_vt (v:viewt@ype+, b:bool) = 317 | | Some_vt (v, true) of v 318 | | None_vt (v, false) 319 | 320 | prfun check {b: bool | b == true} (): void (* = () *) 321 | -------------------------------------------------------------------------------- /prelude/fixity.ats: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* Applied Type System *) 4 | (* *) 5 | (* Hongwei Xi *) 6 | (* *) 7 | (***********************************************************************) 8 | 9 | (* 10 | ** ATS - Unleashing the Potential of Types! 11 | ** Copyright (C) 2002-2008 Hongwei Xi, Boston University 12 | ** All rights reserved 13 | ** 14 | ** ATS is free software; you can redistribute it and/or modify it under 15 | ** the terms of the GNU LESSER GENERAL PUBLIC LICENSE as published by the 16 | ** Free Software Foundation; either version 2.1, or (at your option) any 17 | ** later version. 18 | ** 19 | ** ATS is distributed in the hope that it will be useful, but WITHOUT ANY 20 | ** WARRANTY; without even the implied warranty of MERCHANTABILITY or 21 | ** FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 22 | ** for more details. 23 | ** 24 | ** You should have received a copy of the GNU General Public License 25 | ** along with ATS; see the file COPYING. If not, please write to the 26 | ** Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 27 | ** 02110-1301, USA. 28 | *) 29 | 30 | (* ****** ****** *) 31 | 32 | // author of the file: Hongwei Xi (hwxi AT cs DOT bu DOT edu) 33 | 34 | (* ****** ****** *) 35 | 36 | // some fixity declarations 37 | 38 | #include "prelude/params.hats" 39 | 40 | #if VERBOSE_FIXITY #then 41 | #print "Loading [fixity.ats] starts!\n" 42 | #endif // end of [VERBOSE_FIXITY] 43 | 44 | (* ****** ****** *) 45 | 46 | // prefix 00 ! (* static *) 47 | 48 | prefix 99 ! (* dynamic *) 49 | 50 | // postfix 80 .lab // dynamic 51 | // postfix 80 ->lab // dynamic 52 | // prefix 79 & // dynamic 53 | 54 | // infixl 70 app 55 | // postfix 69 ? 56 | 57 | prefix 61 ~ 58 | 59 | infixl 60 * / 60 | infixl ( * ) imul imul1 imul2 nmul umul 61 | infixl ( / ) idiv idiv1 idiv2 idiv3 ndiv udiv 62 | 63 | infix 60 mod 64 | infix (mod) nmod nmod1 nmod2 umod umod2 uimod 65 | 66 | infixl 50 + - 67 | infixl ( + ) iadd fadd padd uadd 68 | infixl ( - ) isub nsub fsub psub usub 69 | 70 | infixl 41 asl asr lsl lsr 71 | 72 | infix 40 < <= > >= << >> 73 | infixl ( < ) ilt flt plt ult 74 | infixl ( <= ) ilte flte plte ulte 75 | infixl ( > ) igt fgt pgt ugt 76 | infixl ( >= ) igte fgte pgte ugte 77 | 78 | infixr 40 :: @ <: 79 | 80 | infix 30 = := == <> != 81 | infix ( = ) ieq feq peq ueq 82 | infix ( <> ) ineq fneq pneq uneq 83 | infixr 20 -> 84 | 85 | infixl 20 && 86 | infixl ( && ) andalso land 87 | 88 | infixl 10 || 89 | infixl ( || ) orelse lor lxor 90 | 91 | (* 92 | 93 | infix 0 >> << 94 | 95 | *) 96 | 97 | (* ****** ****** *) 98 | 99 | #if VERBOSE_FIXITY #then 100 | #print "Loading [fixity.ats] finishes!\n" 101 | #endif // end of [VERBOSE_FIXITY] 102 | 103 | (* end of [fixity.ats] *) 104 | -------------------------------------------------------------------------------- /prelude/limits.sats: -------------------------------------------------------------------------------- 1 | // This defines architecture-dependent limits for integer types. 2 | 3 | #define CHAR_MIN (~0x80) 4 | #define CHAR_MAX 0x7F 5 | #define SHRT_MIN (~0x8000) 6 | #define SHRT_MAX 0x7FFF 7 | #define INT_MAX 0x7FFFFFFF 8 | #define INT_MIN (~0x80000000) 9 | #define LONG_MAX 0x7FFFFFFF 10 | #define LONG_MIN (~0x80000000) 11 | #define LLONG_MAX 0x7FFFFFFFFFFFFFFF 12 | #define LLONG_MIN (~0x8000000000000000) 13 | 14 | #define UCHAR_MIN 0 15 | #define USHRT_MIN 0 16 | #define UINT_MIN 0 17 | #define ULONG_MIN 0 18 | #define ULLONG_MIN 0 19 | 20 | #define UCHAR_MAX 0xFF 21 | #define USHRT_MAX 0xFFFF 22 | #define UINT_MAX 0xFFFFFFFF 23 | #define ULONG_MAX 0xFFFFFFFF 24 | #define ULLONG_MAX 0xFFFFFFFFFFFFFFFF 25 | 26 | #define INT_BIT 32 27 | #define UINT_BIT 32 28 | 29 | #define UINT8_MIN 0 30 | #define UINT16_MIN 0 31 | #define UINT32_MIN 0 32 | #define UINT8_MAX 0xFF 33 | #define UINT16_MAX 0xFFFF 34 | #define UINT32_MAX 0xFFFFFFFF 35 | 36 | #define UINTPTR_MIN 0 37 | #define UINTPTR_MAX 0xFFFFFFFF 38 | 39 | #define SIZE_MIN 0 40 | #define SIZE_MAX 0xFFFFFFFF 41 | 42 | sortdef Byte = {a: int | a >= CHAR_MIN && a <= CHAR_MAX} 43 | sortdef Short = {a: int | a >= SHRT_MIN && a <= SHRT_MAX} 44 | sortdef Int = {a: int | a >= INT_MIN && a <= INT_MAX} 45 | sortdef Nat = {a: Int | a >= 0} 46 | sortdef Pos = {a: Int | a > 0} 47 | sortdef Long = {a: int | a >= LONG_MIN && a <= LONG_MAX} 48 | sortdef Llong = {a: int | a >= LLONG_MIN && a <= LLONG_MAX} 49 | 50 | sortdef Ubyte = {a: int | a >= UCHAR_MIN && a <= UCHAR_MAX} 51 | sortdef Ushort = {a: int | a >= USHRT_MIN && a <= USHRT_MAX} 52 | sortdef Uint = {a: nat | a >= UINT_MIN && a <= UINT_MAX} 53 | sortdef Ulong = {a: int | a >= ULONG_MIN && a <= ULONG_MAX} 54 | sortdef Ullong = {a: int | a >= ULLONG_MIN && a <= ULLONG_MAX} 55 | 56 | 57 | sortdef Uint8 = {a: int | a >= UINT8_MIN && a <= UINT8_MAX} 58 | sortdef Uint16 = {a: int | a >= UINT16_MIN && a <= UINT16_MAX} 59 | sortdef Uint32 = {a: int | a >= UINT32_MIN && a <= UINT32_MAX} 60 | sortdef Uintptr = {a: int | a >= UINTPTR_MIN && a <= UINTPTR_MAX} 61 | sortdef Size = {a: int | a >= SIZE_MIN && a <= SIZE_MAX} 62 | 63 | typedef Int = [i: Int] int i 64 | typedef Nat = [i: Nat] int i 65 | typedef Pos = [i: Pos] int i 66 | -------------------------------------------------------------------------------- /prelude/macrodef.sats: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xlq/aos/599805d004fbb99b36b8a8477166d369b0a31f24/prelude/macrodef.sats -------------------------------------------------------------------------------- /prelude/params.hats: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* Applied Type System *) 4 | (* *) 5 | (* Hongwei Xi *) 6 | (* *) 7 | (***********************************************************************) 8 | 9 | (* 10 | ** ATS - Unleashing the Potential of Types! 11 | ** Copyright (C) 2002-2010 Hongwei Xi, Boston University 12 | ** All rights reserved 13 | ** 14 | ** ATS is free software; you can redistribute it and/or modify it under 15 | ** the terms of the GNU LESSER GENERAL PUBLIC LICENSE as published by the 16 | ** Free Software Foundation; either version 2.1, or (at your option) any 17 | ** later version. 18 | ** 19 | ** ATS is distributed in the hope that it will be useful, but WITHOUT ANY 20 | ** WARRANTY; without even the implied warranty of MERCHANTABILITY or 21 | ** FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 22 | ** for more details. 23 | ** 24 | ** You should have received a copy of the GNU General Public License 25 | ** along with ATS; see the file COPYING. If not, please write to the 26 | ** Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 27 | ** 02110-1301, USA. 28 | *) 29 | 30 | (* ****** ****** *) 31 | // 32 | // author of the file: Hongwei Xi (hwxi AT cs DOT bu DOT edu) 33 | // 34 | (* ****** ****** *) 35 | 36 | #define VERBOSE_FIXITY 0 (* used in [prelude/fixity.ats] *) 37 | #define VERBOSE_PRELUDE 0 (* mainly for the purpose of debugging *) 38 | 39 | (* ****** ****** *) 40 | 41 | #define ATS_MAJOR_VERSION 0 42 | #define ATS_MINOR_VERSION 2 43 | #define ATS_MICRO_VERSION 7 44 | 45 | (* ****** ****** *) 46 | 47 | #define ATS_VERBOSE_LEVEL 0 48 | 49 | #define ATS_CC_VERBOSE_LEVEL 1 // this one is used in the following files 50 | // $ATSHOME/src/ats_ccomp_emit.dats 51 | 52 | #define ATS_GC_VERBOSE_LEVEL 0 // this one is used in the following files 53 | // $ATSHOME/ccomp/runtime/GCATS/gc_top.dats 54 | 55 | (* ****** ****** *) 56 | 57 | #define ATS_PKGCONFIG 1 // this one is used in the following files: 58 | // $ATSHOME/utils/scripts/atscc_main.dats 59 | 60 | (* ****** ****** *) 61 | 62 | (* end of [params.hats] *) 63 | -------------------------------------------------------------------------------- /prelude/sortdef.sats: -------------------------------------------------------------------------------- 1 | sortdef igz = {a: int | a > 0} 2 | and pos = igz 3 | and ilz = {a: int | a < 0} 4 | and inz = {a: int | a <> 0} 5 | and nat = {a: int | a >= 0} 6 | and agz = {a: addr | a > null} 7 | and agez = {a: addr | a >= null} 8 | -------------------------------------------------------------------------------- /serial.dats: -------------------------------------------------------------------------------- 1 | staload "serial.sats" 2 | staload "portio.sats" 3 | 4 | typedef port_t = [x: Nat | x + 8 <= UINT16_MAX] uint x 5 | 6 | assume serial_port = 7 | @{ 8 | port = port_t, 9 | irq = int 10 | } 11 | 12 | val COM1_IRQ = 4 13 | val COM2_IRQ = 3 14 | val COM1_BASE = 0x3F8u 15 | val COM2_BASE = 0x2F8u 16 | val COM3_BASE = 0x3E8u 17 | val COM4_BASE = 0x2E8u 18 | 19 | (* Is a UART present? *) 20 | fn detect_uart (port: &serial_port):<> bool = 21 | let 22 | val tmp = inb (uint16_of (port.port + 4u)) 23 | in 24 | outb (uint16_of (port.port + 4u), uint8_of 0x10u); 25 | if (inb (uint16_of (port.port + 6u)) land uint8_of 0xF0u) > uint8_of 0u then begin 26 | false 27 | end else begin 28 | outb (uint16_of (port.port + 4u), uint8_of 0x1Fu); 29 | if (inb (uint16_of (port.port + 6u)) land uint8_of 0xF0u) 30 | != uint8_of 0xF0u then false 31 | else begin 32 | (* restore tmp *) 33 | outb (uint16_of (port.port + 4u), tmp); 34 | true 35 | end 36 | end 37 | end 38 | 39 | fn wait_for_uart_ready (port: &serial_port): void = 40 | while ((inb (uint16_of (port.port + 5u)) 41 | land uint8_of 0x20u) = uint8_of 0u) () 42 | 43 | implement init (port, com_number, baud) = 44 | let 45 | val (portnum, irq) = case+ com_number of 46 | | 1 => (COM1_BASE, COM1_IRQ) 47 | | 2 => (COM2_BASE, COM2_IRQ) 48 | | 3 => (COM3_BASE, COM1_IRQ) 49 | | 4 => (COM4_BASE, COM2_IRQ) 50 | in 51 | port := @{ port = portnum, irq = irq }; 52 | if not (detect_uart port) then 53 | (* No UART is present. *) 54 | let prval () = opt_none {serial_port} port in false; end 55 | else 56 | let val divisor = 115200u / baud in 57 | if divisor > uint1_of UINT16_MAX then 58 | (* Baud rate is too low! *) 59 | let prval () = opt_none {serial_port} port in false; end 60 | else begin 61 | outb (uint16_of (port.port + 1u), uint8_of 0x00u); // disable all interrupts 62 | outb (uint16_of (port.port + 3u), uint8_of 0x80u); // enable 'DLAB' - baud rate divisor 63 | outb (uint16_of (port.port + 0u), uint8_of (divisor land 0xFFu)); // divisor (lower) 64 | outb (uint16_of (port.port + 1u), uint8_of (0xFFu land (divisor >> 8))); // divisor (upper) 65 | outb (uint16_of (port.port + 3u), uint8_of 0x03u); // 8 bits, no parity, one stop bit 66 | outb (uint16_of (port.port + 2u), uint8_of 0xC7u); // enable FIFO, clear them, with 14 byte threshold 67 | outb (uint16_of (port.port + 4u), uint8_of 0x0Bu); // enable something? 68 | outb (uint16_of (port.port + 4u), inb (uint16_of (port.port + 4u)) lor uint8_of 8u); // set OUT2 bit to enable interrupts 69 | outb (uint16_of (port.port + 1u), uint8_of 0x01u); // enable ERBFI (receiver buffer full interrupt) 70 | (* Success. *) 71 | let prval () = opt_some {serial_port} port in true; end 72 | end 73 | end 74 | end 75 | 76 | fn sanitise_output (port: &serial_port, ch: char): char = 77 | case+ ch of 78 | | '\n' => (send_char (port, '\r'); '\n') (* LF -> CRLF *) 79 | | '\b' => '\0' 80 | | _ => ch 81 | 82 | implement send_char (port, ch) = 83 | (* Remove characters we don't want (control characters, etc.) *) 84 | let 85 | val ch' = sanitise_output (port, ch) 86 | in 87 | wait_for_uart_ready (port); 88 | outb (uint16_of port.port, ubyte_of (ch')) (* send! *) 89 | end 90 | 91 | implement send_string (port, len, str) = 92 | let 93 | var i: [i: Nat] int i 94 | in 95 | for (i := 0; i < len; i := i + 1) 96 | send_char (port, str[i]) 97 | end 98 | -------------------------------------------------------------------------------- /serial.sats: -------------------------------------------------------------------------------- 1 | (* PC serial port output. *) 2 | 3 | staload "prelude/limits.sats" 4 | 5 | abst@ype serial_port = 6 | @{ 7 | port = uint16, 8 | irq = int 9 | } 10 | 11 | fun init 12 | {com_number: int | com_number >= 1 && com_number <= 4} 13 | {baud: Uint | baud > 0} 14 | (port: &serial_port? >> opt(serial_port, success), 15 | com_number: int com_number, 16 | baud: uint baud): #[success: bool] bool success 17 | 18 | fun send_char 19 | (port: &serial_port, 20 | ch: char): void 21 | 22 | fun send_string 23 | {len: Int} 24 | (port: &serial_port, 25 | len: int len, 26 | str: string len): void 27 | -------------------------------------------------------------------------------- /start.S: -------------------------------------------------------------------------------- 1 | .global _start 2 | 3 | /* Stack used for boot code. */ 4 | STACK_SIZE = 4096 /* ought to be enough for anyone */ 5 | .global STACK_SIZE 6 | 7 | .section multiboot, "a" 8 | 9 | /* multiboot header 10 | http://www.gnu.org/software/grub/manual/multiboot/multiboot.html */ 11 | mb_header: 12 | .int 0x1BADB002 /* magic */ 13 | .int 0x00000002 /* flags */ 14 | .int 0xE4524FFC /* checksum */ 15 | 16 | .section startup, "ax" 17 | 18 | _start: 19 | /* Entry point from boot loader. 20 | eax contains magic number 0x2BADB002. 21 | ebx contains a pointer to mb_info. */ 22 | movl %eax,%edx /* magic */ 23 | 24 | /* Disable interrupts. */ 25 | cli 26 | cld 27 | 28 | /* Disable NMI. */ 29 | movb $0x80,%al 30 | outb %al,$0x70 31 | 32 | /* Zero out bss section, in case boot loader didn't. 33 | (ebx, edx are still live here) */ 34 | movl $_bss_start,%edi 35 | movl $_bss_end,%ecx 36 | subl %edi,%ecx 37 | xorl %eax,%eax 38 | rep stosb 39 | 40 | /* Set up initial stack. 41 | The "stack" symbol points to a virtual address. 42 | Convert this to a physical address. */ 43 | movl $stack_bottom,%esp 44 | subl $_virt_base,%esp 45 | addl $_phys_base,%esp 46 | 47 | /* Clear flags. */ 48 | pushl $0 49 | popf 50 | 51 | /* Push multiboot start-up parameters from bootloader. */ 52 | pushl %ebx /* mb_info */ 53 | pushl %edx /* magic */ 54 | 55 | /* Create initial page tables. 56 | 0x00000000 .. 0x003FFFFF is mapped to 0x00000000 */ 57 | movl $boot_page_table,%edi 58 | movl $0x00000003,%eax 59 | movl $1024,%ecx 60 | 1: stosl 61 | addl $0x00001000,%eax 62 | decl %ecx 63 | jnz 1b 64 | 65 | /* Set page directory entries. */ 66 | movl $boot_page_table,%eax 67 | orl $0x00000003,%eax 68 | movl %eax,(boot_page_directory + 0x000) 69 | 70 | /* Load page directory. */ 71 | movl $boot_page_directory,%eax 72 | movl %eax,%cr3 73 | 74 | /* Enable paging. */ 75 | movl %cr0,%eax 76 | bts $31,%eax 77 | movl %eax,%cr0 78 | 79 | /* Move stack pointer to virtual address. */ 80 | subl $_phys_base,%esp 81 | addl $_virt_base,%esp 82 | 83 | /* Call dynamic elaboration code. */ 84 | call _2boot_2edats__staload 85 | call _2boot_2edats__dynload 86 | 87 | /* Call entry point in boot.dats. */ 88 | pushl $hang 89 | jmp ats_entry_point 90 | 91 | .text 92 | hang: 93 | cli 94 | hlt 95 | jmp hang 96 | 97 | .data 98 | .global _2boot_2edats__dynload_flag 99 | _2boot_2edats__dynload_flag: 100 | .int 0 101 | 102 | .bss 103 | stack: 104 | .fill STACK_SIZE,1,0 105 | stack_bottom: 106 | .global stack_bottom 107 | -------------------------------------------------------------------------------- /streams.dats: -------------------------------------------------------------------------------- 1 | staload "streams.sats" 2 | 3 | implement put_char (stream, ch) = 4 | let val f = stream.funcs->put_char where 5 | { prval vbox pf_funcs = stream.pf_funcs } 6 | in () end 7 | 8 | implement put_string1 {ST} {len} (stream, item, len) = 9 | let var i: Int in 10 | for* {i: nat | i <= len} .. (i: int i) => 11 | (i := 0; i < len; i := i + 1) 12 | put_char (stream, item[i]) 13 | end 14 | 15 | implement put_string (stream, item) = 16 | let 17 | val s = string1_of_string item 18 | val len = string_length s 19 | in 20 | put (stream, s, len) 21 | end 22 | 23 | implement put_nat_hex {ST} (_ | stream, x) = 24 | let 25 | val x = uint1_of x 26 | in 27 | if x > 0u then 28 | let 29 | val q = x / 16u 30 | val r = x mod 16u 31 | val chars: string 16 = "0123456789ABCDEF" 32 | in 33 | put_nat_hex {ST} (HEX | stream, int1_of q); 34 | put_char (stream, chars[int1_of r]) 35 | end 36 | end 37 | -------------------------------------------------------------------------------- /streams.sats: -------------------------------------------------------------------------------- 1 | staload "prelude/limits.sats" 2 | 3 | typedef funcs (VT: viewtype) = 4 | @{ 5 | put_char = (!VT, char) - void 6 | } 7 | 8 | viewtypedef stream (VT: viewtype) = 9 | [lfuncs: agz] 10 | @{ 11 | p = VT, 12 | pf_funcs = vbox (funcs VT @ lfuncs), 13 | funcs = ptr lfuncs 14 | } 15 | 16 | fun put_char {ST: viewtype} 17 | (stream: &stream ST, ch: char): void 18 | 19 | symintr put 20 | 21 | fun put_string1 {ST: viewtype} {len: Nat} 22 | (stream: &stream ST, item: string len, len: int len): void 23 | overload put with put_string1 24 | 25 | fun put_string {ST: viewtype} 26 | (stream: &stream ST, item: string): void 27 | overload put with put_string 28 | 29 | dataprop Hex = HEX 30 | fun put_nat_hex {ST: viewtype} 31 | (_: Hex | stream: &stream ST, item: Nat): void 32 | overload put with put_nat_hex 33 | -------------------------------------------------------------------------------- /trace.dats: -------------------------------------------------------------------------------- 1 | staload "trace.sats" 2 | staload "serial.sats" 3 | staload "vga-text.sats" 4 | staload "enablable.sats" 5 | staload "enablable.dats" 6 | 7 | var com1: enablable serial_port = empty () 8 | val (pfcom1 | ()): ([l:agz] vbox (enablable serial_port @ l) | void) 9 | = vbox_make_view_ptr (view@ com1 | &com1) 10 | 11 | var con: enablable console = empty () 12 | val (pfcon | ()): ([l:agz] vbox (enablable console @ l) | void) 13 | = vbox_make_view_ptr (view@ con | &con) 14 | 15 | implement init_serial {com_number} (com_number, baud) = 16 | let 17 | prval vbox pfcom1 = pfcom1 18 | in 19 | if not com1.enabled then 20 | let prval () = opt_unnone com1.obj 21 | in 22 | com1.enabled := init (com1.obj, com_number, baud) 23 | end 24 | end 25 | 26 | implement init_vga () = 27 | let 28 | prval vbox pfcon = pfcon 29 | in 30 | if not con.enabled then 31 | let prval () = opt_unnone con.obj 32 | in 33 | con.enabled := init_B8000 con.obj 34 | end 35 | end 36 | 37 | implement trace (msg) = 38 | let 39 | val msg = string1_of_string msg 40 | in 41 | let prval vbox pfcom1 = pfcom1 in 42 | if com1.enabled then 43 | let 44 | prval () = opt_unsome com1.obj 45 | val () = send_string (com1.obj, string_length msg, msg) 46 | prval () = opt_some com1.obj 47 | in () end 48 | end; 49 | let prval vbox pfcon = pfcon in 50 | if con.enabled then 51 | let 52 | prval () = opt_unsome con.obj 53 | val () = put_string (con.obj, string_length msg, msg) 54 | prval () = opt_some con.obj 55 | in () end 56 | end 57 | end 58 | 59 | implement trace_loc_msg (loc, msg) = 60 | let 61 | val loc = string1_of_string loc 62 | val msg = string1_of_string msg 63 | in 64 | let prval vbox pfcom1 = pfcom1 in 65 | if com1.enabled then 66 | let 67 | prval () = opt_unsome com1.obj 68 | val () = send_string (com1.obj, string_length loc, loc) 69 | val () = send_string (com1.obj, 2, ": ") 70 | val () = send_string (com1.obj, string_length msg, msg) 71 | prval () = opt_some com1.obj 72 | in () end 73 | end; 74 | let prval vbox pfcon = pfcon in 75 | if con.enabled then 76 | let 77 | prval () = opt_unsome con.obj 78 | val () = put_string (con.obj, string_length msg, msg) 79 | prval () = opt_some con.obj 80 | in () end 81 | end 82 | end 83 | 84 | implement panic_loc_msg (loc, msg) = 85 | let 86 | val loc = string1_of_string loc 87 | val msg = string1_of_string msg 88 | in 89 | let prval vbox pfcom1 = pfcom1 in 90 | if com1.enabled then 91 | let 92 | prval () = opt_unsome com1.obj 93 | val () = send_string (com1.obj, string_length loc, loc) 94 | val () = send_string (com1.obj, 23, ":\n*** KERNEL PANIC ***\n") 95 | val () = send_string (com1.obj, string_length msg, msg) 96 | prval () = opt_some com1.obj 97 | in () end 98 | end; 99 | let prval vbox pfcon = pfcon in 100 | if con.enabled then 101 | let 102 | prval () = opt_unsome con.obj 103 | val () = put_string (con.obj, 21, "*** KERNEL PANIC ***\n") 104 | val () = put_string (con.obj, string_length msg, msg) 105 | prval () = opt_some con.obj 106 | in () end 107 | end; 108 | halt_completely () 109 | end 110 | 111 | implement dump_uint (x) = 112 | let prval vbox pfcom1 = pfcom1 in 113 | let var i: Int in 114 | for* {i: Int | i <= 28} (i: int i) => 115 | (i := 28; i >= 0; i := i - 4) begin 116 | let 117 | val mask = 0xF0000000u >> (28-i) 118 | val masked = uint1_of x land mask 119 | val digit = masked >> i 120 | val s: string = "0123456789ABCDEF" 121 | in 122 | if digit < 16u then 123 | if com1.enabled then 124 | let 125 | prval () = opt_unsome com1.obj 126 | val () = send_char (com1.obj, s[int1_of digit]) 127 | prval () = opt_some com1.obj 128 | in end 129 | else 130 | if com1.enabled then 131 | let 132 | prval () = opt_unsome com1.obj 133 | val () = send_char (com1.obj, '?') 134 | prval () = opt_some com1.obj 135 | in end 136 | end 137 | end 138 | end 139 | end 140 | -------------------------------------------------------------------------------- /trace.sats: -------------------------------------------------------------------------------- 1 | (* Functions for printing messages for debugging. 2 | The messages are output to the display and serial port. *) 3 | 4 | staload "prelude/limits.sats" 5 | 6 | fun init_serial 7 | {com_number: int | com_number >= 1 && com_number <= 4} 8 | {baud: Uint | baud > 0} 9 | (com_number: int com_number, 10 | baud: uint baud): void 11 | 12 | fun init_vga (): void 13 | 14 | fun trace (msg: !string): void 15 | 16 | fun trace_loc_msg 17 | (loc: string, msg: string): void 18 | 19 | macdef traceloc (msg) = trace_loc_msg (#LOCATION, ,(msg)) 20 | 21 | fun halt_completely (): void 22 | = "halt_completely" 23 | 24 | fun panic_loc_msg 25 | (loc: string, msg: string): void 26 | 27 | macdef panicloc (msg) = panic_loc_msg (#LOCATION, ,(msg)) 28 | 29 | %{# 30 | static inline void halt_completely (void) 31 | { 32 | while (1){ 33 | __asm__ volatile ("cli ; hlt"); 34 | } 35 | } 36 | %} 37 | 38 | fun dump_uint (x: uint): void 39 | -------------------------------------------------------------------------------- /vga-text.dats: -------------------------------------------------------------------------------- 1 | staload "vga-text.sats" 2 | staload "portio.sats" 3 | 4 | assume colour = [x:nat | x < 16] int x 5 | implement black = 0 6 | implement blue = 1 7 | implement green = 2 8 | implement cyan = 3 9 | implement red = 4 10 | implement magenta = 5 11 | implement brown = 6 12 | implement white = 7 13 | implement grey = 8 14 | implement bright_blue = 9 15 | implement bright_green = 10 16 | implement bright_cyan = 11 17 | implement bright_red = 12 18 | implement bright_magenta = 13 19 | implement bright_yellow = 14 20 | implement bright_white = 15 21 | 22 | typedef cell = @{ ch = char, attrib = uint8 } 23 | 24 | absview vram (l: addr) 25 | 26 | viewtypedef tmat2 (width: int, height: int, x: int, y: int) = 27 | [l: agz] [width * height >= 1 && width * height <= INT_MAX] 28 | [x < width] [y < height] 29 | @{ 30 | width = int width, 31 | height = int height, 32 | x = int x, 33 | y = int y, 34 | attrib = uint8, // current colours 35 | fr_vram = vram l, 36 | pf_vram = @[cell][width*height] @ l, 37 | vram = ptr l 38 | } 39 | 40 | viewtypedef tmat1 (width: int, height: int) = 41 | [x: nat | x < width] [y: nat | y < height] 42 | tmat2 (width, height, x, y) 43 | 44 | viewtypedef tmat = [width, height: Pos] tmat1 (width, height) 45 | 46 | assume console = tmat 47 | 48 | extern fun get_vram ():<> 49 | [l: agz] (vram l, @[cell][80*25] @ l | ptr l) 50 | = "mac#get_vram" 51 | 52 | extern prfun eat_vram {l: agz} {n: int} 53 | (fr: vram l, pf: @[cell][n] @ l): void 54 | 55 | %{^ 56 | #define get_vram() ((void *) 0xB8000) 57 | %} 58 | 59 | prfn mul_lt {w,h,x,y:nat | x < w && y < h} 60 | (): [y*w+x < w*h && y*w >= 0] void = 61 | let 62 | prval pf_yw = mul_istot {y, w} () 63 | prval pf_wh = mul_istot {w, h} () 64 | prval pf_y1w = mul_istot {y+1, w} () 65 | prval () = mul_nat_nat_nat pf_yw 66 | prval () = mul_nat_nat_nat pf_wh 67 | prval () = mul_nat_nat_nat (mul_distribute2 (mul_negate pf_y1w, mul_commute pf_wh)) 68 | prval () = mul_isfun (pf_y1w, mul_add_const {1} (pf_yw)) 69 | prval () = mul_elim pf_wh 70 | prval () = mul_elim pf_yw 71 | in 72 | () 73 | end 74 | 75 | implement default_colours (con) = con.attrib := uint8_of 7u 76 | 77 | implement set_colour (con, fg) = 78 | con.attrib := uint8_of ( 79 | (uint1_of (uint8_1_of con.attrib) land 0xF0u) 80 | lor uint1_of fg) 81 | 82 | implement set_background (con, [bg: int] bg) = 83 | let 84 | val bg = uint1_of bg 85 | prval pf_bg = SHL_make {bg, 4} () 86 | prval () = SHL_monotone (pf_bg, ,(pf_shl_const 0xF 4)) 87 | val bg' = ushl (pf_bg | bg, 4) 88 | val bg' = uint8_of bg' 89 | in 90 | con.attrib := ((con.attrib land uint8_of 0x0Fu) lor bg') 91 | end 92 | 93 | (* Get position of the hardware cursor. *) 94 | fn get_hw_cursor {w,h:Pos} 95 | (self: &tmat1(w,h)):<> void = 96 | let 97 | val () = outb (uint16_of 0x3D4u, uint8_of 14u) 98 | val pos_hi = inb (uint16_of 0x3D5u) 99 | val () = outb (uint16_of 0x3D4u, uint8_of 15u) 100 | val pos_lo = inb (uint16_of 0x3D5u) 101 | val [pos_hi: int] pos_hi = uint8_1_of pos_hi 102 | prval pf_pos_hi = SHL_make {pos_hi, 8} () 103 | prval () = SHL_monotone (pf_pos_hi, ,(pf_shl_const 0xFF 8)) 104 | val pos = ushl (pf_pos_hi | uint1_of pos_hi, 8) 105 | lor uint1_of (uint8_1_of pos_lo) 106 | val pos_y = pos / uint1_of self.width 107 | in 108 | if pos_y < uint1_of self.height then 109 | self.y := int1_of pos_y 110 | else 111 | self.y := self.height - 1; // out of range! 112 | self.x := int1_of (pos mod uint1_of self.width) 113 | end 114 | 115 | (* Set position of the hardware cursor. *) 116 | fn set_hw_cursor {w,h:Pos} {x,y:Nat | x < w && y < h} 117 | (self: &tmat2(w,h,x,y)):<> void = 118 | let 119 | prval () = mul_lt {w,h,x,y} () 120 | val tmp = uint1_of (self.y * self.width + self.x) 121 | in 122 | if tmp <= uint1_of UINT16_MAX then 123 | let 124 | val (pf_tmp_hi | tmp_hi) = ushr (tmp, 8) 125 | prval () = SHR_monotone (pf_tmp_hi, (,(pf_exp2_const 8), div_istot {0xFFFF, 0x100} ())) 126 | val () = outb (uint16_of 0x3D4u, uint8_of 14u) 127 | val () = outb (uint16_of 0x3D5u, uint8_of tmp_hi) 128 | val () = outb (uint16_of 0x3D4u, uint8_of 15u) 129 | val () = outb (uint16_of 0x3D5u, uint8_of (tmp land 0xFFu)) 130 | in 131 | () 132 | end 133 | end 134 | 135 | (* move_elements (arr, from, to, count) 136 | Move count elements from "from" to "to". *) 137 | fn {t: t@ype} move_elements 138 | {len: Nat} {from, to, count: nat | from + count <= len && to + count <= len && to <= from} 139 | (arr: &(@[t][len]), from: int from, to: int to, count: int count):<> void = 140 | let 141 | var i: Int 142 | in 143 | for* {i:nat | i <= count} .. (i: int i) 144 | => (i := 0; i < count; i := i + 1) 145 | arr.[to + i] := arr.[from + i] 146 | end 147 | 148 | fun {t: t@ype} set_elements 149 | {len: Nat} {start, count: nat | start + count <= len} .. 150 | (arr: &(@[t][len]), start: int start, count: int count, elem: t):<> void 151 | = 152 | if count > 0 then begin 153 | arr.[start] := elem; 154 | set_elements (arr, start+1, count-1, elem) 155 | end 156 | 157 | fn put_char_at 158 | {width, height, x0, y0: Nat | x0 < width && y0 < height} 159 | {x, y: Nat | x < width && y < height} 160 | (mat: &tmat2(width, height, x0, y0), x: int x, y: int y, ch: char):<> void 161 | = 162 | let 163 | prval () = mul_lt {width, height, x, y} () 164 | prval pf_vram = mat.pf_vram 165 | in 166 | mat.vram->[y * mat.width + x] := @{ ch = ch, attrib = mat.attrib }; 167 | mat.pf_vram := pf_vram 168 | end 169 | 170 | fn scroll {w,h: Pos} {x,y: Nat} 171 | (self: &tmat2(w,h,x,y)):<> void = 172 | let 173 | prval () = mul_pos_pos_pos (mul_make {h,w} ()) 174 | prval () = mul_isfun (mul_add_const {~1} (mul_make {h,w} ()), 175 | mul_make {h-1,w} ()) 176 | prval () = mul_elim (mul_commute (mul_make {h,w} ())) 177 | prval pf_vram = self.pf_vram 178 | in 179 | move_elements (!(self.vram), self.width, 0, 180 | (self.height - 1) * self.width); 181 | set_elements (!(self.vram), (self.height - 1) * self.width, 182 | self.width, @{ ch = ' ', attrib = uint8_of 7u }); 183 | self.pf_vram := pf_vram 184 | end 185 | 186 | fn newline (self: &console):<> void = 187 | begin 188 | self.x := 0; 189 | if self.y < self.height - 1 then 190 | self.y := self.y + 1 191 | else 192 | scroll self 193 | end 194 | 195 | fn put_char_inner (self: &console, ch: c1har):<> void = 196 | begin 197 | if ch = '\n' then newline self 198 | else begin 199 | put_char_at (self, self.x, self.y, ch); 200 | if self.x < self.width - 1 then begin 201 | self.x := self.x + 1 202 | end else newline self 203 | end 204 | end 205 | 206 | implement put_char (con, ch) = 207 | begin 208 | put_char_inner (con, ch); 209 | set_hw_cursor con 210 | end 211 | 212 | implement put_string {len} (con, len, str) = 213 | let 214 | var i: Int 215 | in 216 | begin 217 | for* {i: nat | i <= len} .. (i: int i) 218 | => (i := 0; i < len; i := i + 1) 219 | put_char_inner (con, str[i]) 220 | end; 221 | set_hw_cursor con 222 | end 223 | 224 | implement init_B8000 (con) = 225 | let 226 | val (fr_vram, pf_vram | vram) = get_vram () 227 | in 228 | con := @{ 229 | width = 80, height = 25, 230 | x = 0, y = 0, 231 | attrib = uint8_of 7u, 232 | fr_vram = fr_vram, pf_vram = pf_vram, 233 | vram = vram 234 | }; 235 | get_hw_cursor con; 236 | let prval () = opt_some con in true; end 237 | end 238 | 239 | implement finit (con) = 240 | let prval () = eat_vram (con.fr_vram, con.pf_vram) in () end 241 | -------------------------------------------------------------------------------- /vga-text.sats: -------------------------------------------------------------------------------- 1 | staload "prelude/limits.sats" 2 | 3 | absviewt@ype console = @(int, int, int, int, uint8, ptr) 4 | 5 | abst@ype colour = int 6 | val black: colour 7 | val blue: colour 8 | val green: colour 9 | val cyan: colour 10 | val red: colour 11 | val magenta: colour 12 | val brown: colour 13 | val white: colour 14 | val grey: colour 15 | val bright_blue: colour 16 | val bright_green: colour 17 | val bright_cyan: colour 18 | val bright_red: colour 19 | val bright_magenta: colour 20 | val bright_yellow: colour 21 | val bright_white: colour 22 | 23 | (* Initialise a text console for VRAM at 0xB8000. *) 24 | fun init_B8000 25 | (con: &console? >> opt (console, success)):<> #[success: bool] 26 | bool success 27 | 28 | fun finit (con: &console >> console?):<> void 29 | 30 | fun default_colours (con: &console):<> void 31 | fun set_colour (con: &console, fg: colour):<> void 32 | fun set_background (con: &console, bg: colour):<> void 33 | 34 | symintr put 35 | 36 | fun put_char (con: &console, ch: c1har):<> void 37 | overload put with put_char 38 | 39 | fun put_string {len:Nat} 40 | (con: &console, len: int len, str: string len):<> void 41 | overload put with put_string 42 | --------------------------------------------------------------------------------