├── LICENSE ├── README.md └── src ├── Makefile ├── READ_ME ├── l.h ├── l_check.c ├── l_end.c ├── l_exec.c ├── l_fs.c ├── l_in.c ├── l_init.c ├── l_load.c ├── l_main.c ├── l_mnem.c ├── l_quit.c ├── l_stor.c ├── l_storage.c ├── l_svc.c └── l_trace.c /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 2, June 1991 3 | 4 | Copyright (C) 1989, 1991 Free Software Foundation, Inc., 5 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 6 | Everyone is permitted to copy and distribute verbatim copies 7 | of this license document, but changing it is not allowed. 8 | 9 | Preamble 10 | 11 | The licenses for most software are designed to take away your 12 | freedom to share and change it. By contrast, the GNU General Public 13 | License is intended to guarantee your freedom to share and change free 14 | software--to make sure the software is free for all its users. This 15 | General Public License applies to most of the Free Software 16 | Foundation's software and to any other program whose authors commit to 17 | using it. (Some other Free Software Foundation software is covered by 18 | the GNU Lesser General Public License instead.) You can apply it to 19 | your programs, too. 20 | 21 | When we speak of free software, we are referring to freedom, not 22 | price. Our General Public Licenses are designed to make sure that you 23 | have the freedom to distribute copies of free software (and charge for 24 | this service if you wish), that you receive source code or can get it 25 | if you want it, that you can change the software or use pieces of it 26 | in new free programs; and that you know you can do these things. 27 | 28 | To protect your rights, we need to make restrictions that forbid 29 | anyone to deny you these rights or to ask you to surrender the rights. 30 | These restrictions translate to certain responsibilities for you if you 31 | distribute copies of the software, or if you modify it. 32 | 33 | For example, if you distribute copies of such a program, whether 34 | gratis or for a fee, you must give the recipients all the rights that 35 | you have. You must make sure that they, too, receive or can get the 36 | source code. And you must show them these terms so they know their 37 | rights. 38 | 39 | We protect your rights with two steps: (1) copyright the software, and 40 | (2) offer you this license which gives you legal permission to copy, 41 | distribute and/or modify the software. 42 | 43 | Also, for each author's protection and ours, we want to make certain 44 | that everyone understands that there is no warranty for this free 45 | software. If the software is modified by someone else and passed on, we 46 | want its recipients to know that what they have is not the original, so 47 | that any problems introduced by others will not reflect on the original 48 | authors' reputations. 49 | 50 | Finally, any free program is threatened constantly by software 51 | patents. We wish to avoid the danger that redistributors of a free 52 | program will individually obtain patent licenses, in effect making the 53 | program proprietary. To prevent this, we have made it clear that any 54 | patent must be licensed for everyone's free use or not licensed at all. 55 | 56 | The precise terms and conditions for copying, distribution and 57 | modification follow. 58 | 59 | GNU GENERAL PUBLIC LICENSE 60 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 61 | 62 | 0. This License applies to any program or other work which contains 63 | a notice placed by the copyright holder saying it may be distributed 64 | under the terms of this General Public License. The "Program", below, 65 | refers to any such program or work, and a "work based on the Program" 66 | means either the Program or any derivative work under copyright law: 67 | that is to say, a work containing the Program or a portion of it, 68 | either verbatim or with modifications and/or translated into another 69 | language. (Hereinafter, translation is included without limitation in 70 | the term "modification".) Each licensee is addressed as "you". 71 | 72 | Activities other than copying, distribution and modification are not 73 | covered by this License; they are outside its scope. The act of 74 | running the Program is not restricted, and the output from the Program 75 | is covered only if its contents constitute a work based on the 76 | Program (independent of having been made by running the Program). 77 | Whether that is true depends on what the Program does. 78 | 79 | 1. You may copy and distribute verbatim copies of the Program's 80 | source code as you receive it, in any medium, provided that you 81 | conspicuously and appropriately publish on each copy an appropriate 82 | copyright notice and disclaimer of warranty; keep intact all the 83 | notices that refer to this License and to the absence of any warranty; 84 | and give any other recipients of the Program a copy of this License 85 | along with the Program. 86 | 87 | You may charge a fee for the physical act of transferring a copy, and 88 | you may at your option offer warranty protection in exchange for a fee. 89 | 90 | 2. You may modify your copy or copies of the Program or any portion 91 | of it, thus forming a work based on the Program, and copy and 92 | distribute such modifications or work under the terms of Section 1 93 | above, provided that you also meet all of these conditions: 94 | 95 | a) You must cause the modified files to carry prominent notices 96 | stating that you changed the files and the date of any change. 97 | 98 | b) You must cause any work that you distribute or publish, that in 99 | whole or in part contains or is derived from the Program or any 100 | part thereof, to be licensed as a whole at no charge to all third 101 | parties under the terms of this License. 102 | 103 | c) If the modified program normally reads commands interactively 104 | when run, you must cause it, when started running for such 105 | interactive use in the most ordinary way, to print or display an 106 | announcement including an appropriate copyright notice and a 107 | notice that there is no warranty (or else, saying that you provide 108 | a warranty) and that users may redistribute the program under 109 | these conditions, and telling the user how to view a copy of this 110 | License. (Exception: if the Program itself is interactive but 111 | does not normally print such an announcement, your work based on 112 | the Program is not required to print an announcement.) 113 | 114 | These requirements apply to the modified work as a whole. If 115 | identifiable sections of that work are not derived from the Program, 116 | and can be reasonably considered independent and separate works in 117 | themselves, then this License, and its terms, do not apply to those 118 | sections when you distribute them as separate works. But when you 119 | distribute the same sections as part of a whole which is a work based 120 | on the Program, the distribution of the whole must be on the terms of 121 | this License, whose permissions for other licensees extend to the 122 | entire whole, and thus to each and every part regardless of who wrote it. 123 | 124 | Thus, it is not the intent of this section to claim rights or contest 125 | your rights to work written entirely by you; rather, the intent is to 126 | exercise the right to control the distribution of derivative or 127 | collective works based on the Program. 128 | 129 | In addition, mere aggregation of another work not based on the Program 130 | with the Program (or with a work based on the Program) on a volume of 131 | a storage or distribution medium does not bring the other work under 132 | the scope of this License. 133 | 134 | 3. You may copy and distribute the Program (or a work based on it, 135 | under Section 2) in object code or executable form under the terms of 136 | Sections 1 and 2 above provided that you also do one of the following: 137 | 138 | a) Accompany it with the complete corresponding machine-readable 139 | source code, which must be distributed under the terms of Sections 140 | 1 and 2 above on a medium customarily used for software interchange; or, 141 | 142 | b) Accompany it with a written offer, valid for at least three 143 | years, to give any third party, for a charge no more than your 144 | cost of physically performing source distribution, a complete 145 | machine-readable copy of the corresponding source code, to be 146 | distributed under the terms of Sections 1 and 2 above on a medium 147 | customarily used for software interchange; or, 148 | 149 | c) Accompany it with the information you received as to the offer 150 | to distribute corresponding source code. (This alternative is 151 | allowed only for noncommercial distribution and only if you 152 | received the program in object code or executable form with such 153 | an offer, in accord with Subsection b above.) 154 | 155 | The source code for a work means the preferred form of the work for 156 | making modifications to it. For an executable work, complete source 157 | code means all the source code for all modules it contains, plus any 158 | associated interface definition files, plus the scripts used to 159 | control compilation and installation of the executable. However, as a 160 | special exception, the source code distributed need not include 161 | anything that is normally distributed (in either source or binary 162 | form) with the major components (compiler, kernel, and so on) of the 163 | operating system on which the executable runs, unless that component 164 | itself accompanies the executable. 165 | 166 | If distribution of executable or object code is made by offering 167 | access to copy from a designated place, then offering equivalent 168 | access to copy the source code from the same place counts as 169 | distribution of the source code, even though third parties are not 170 | compelled to copy the source along with the object code. 171 | 172 | 4. You may not copy, modify, sublicense, or distribute the Program 173 | except as expressly provided under this License. Any attempt 174 | otherwise to copy, modify, sublicense or distribute the Program is 175 | void, and will automatically terminate your rights under this License. 176 | However, parties who have received copies, or rights, from you under 177 | this License will not have their licenses terminated so long as such 178 | parties remain in full compliance. 179 | 180 | 5. You are not required to accept this License, since you have not 181 | signed it. However, nothing else grants you permission to modify or 182 | distribute the Program or its derivative works. These actions are 183 | prohibited by law if you do not accept this License. Therefore, by 184 | modifying or distributing the Program (or any work based on the 185 | Program), you indicate your acceptance of this License to do so, and 186 | all its terms and conditions for copying, distributing or modifying 187 | the Program or works based on it. 188 | 189 | 6. Each time you redistribute the Program (or any work based on the 190 | Program), the recipient automatically receives a license from the 191 | original licensor to copy, distribute or modify the Program subject to 192 | these terms and conditions. You may not impose any further 193 | restrictions on the recipients' exercise of the rights granted herein. 194 | You are not responsible for enforcing compliance by third parties to 195 | this License. 196 | 197 | 7. If, as a consequence of a court judgment or allegation of patent 198 | infringement or for any other reason (not limited to patent issues), 199 | conditions are imposed on you (whether by court order, agreement or 200 | otherwise) that contradict the conditions of this License, they do not 201 | excuse you from the conditions of this License. If you cannot 202 | distribute so as to satisfy simultaneously your obligations under this 203 | License and any other pertinent obligations, then as a consequence you 204 | may not distribute the Program at all. For example, if a patent 205 | license would not permit royalty-free redistribution of the Program by 206 | all those who receive copies directly or indirectly through you, then 207 | the only way you could satisfy both it and this License would be to 208 | refrain entirely from distribution of the Program. 209 | 210 | If any portion of this section is held invalid or unenforceable under 211 | any particular circumstance, the balance of the section is intended to 212 | apply and the section as a whole is intended to apply in other 213 | circumstances. 214 | 215 | It is not the purpose of this section to induce you to infringe any 216 | patents or other property right claims or to contest validity of any 217 | such claims; this section has the sole purpose of protecting the 218 | integrity of the free software distribution system, which is 219 | implemented by public license practices. Many people have made 220 | generous contributions to the wide range of software distributed 221 | through that system in reliance on consistent application of that 222 | system; it is up to the author/donor to decide if he or she is willing 223 | to distribute software through any other system and a licensee cannot 224 | impose that choice. 225 | 226 | This section is intended to make thoroughly clear what is believed to 227 | be a consequence of the rest of this License. 228 | 229 | 8. If the distribution and/or use of the Program is restricted in 230 | certain countries either by patents or by copyrighted interfaces, the 231 | original copyright holder who places the Program under this License 232 | may add an explicit geographical distribution limitation excluding 233 | those countries, so that distribution is permitted only in or among 234 | countries not thus excluded. In such case, this License incorporates 235 | the limitation as if written in the body of this License. 236 | 237 | 9. The Free Software Foundation may publish revised and/or new versions 238 | of the General Public License from time to time. Such new versions will 239 | be similar in spirit to the present version, but may differ in detail to 240 | address new problems or concerns. 241 | 242 | Each version is given a distinguishing version number. If the Program 243 | specifies a version number of this License which applies to it and "any 244 | later version", you have the option of following the terms and conditions 245 | either of that version or of any later version published by the Free 246 | Software Foundation. If the Program does not specify a version number of 247 | this License, you may choose any version ever published by the Free Software 248 | Foundation. 249 | 250 | 10. If you wish to incorporate parts of the Program into other free 251 | programs whose distribution conditions are different, write to the author 252 | to ask for permission. For software which is copyrighted by the Free 253 | Software Foundation, write to the Free Software Foundation; we sometimes 254 | make exceptions for this. Our decision will be guided by the two goals 255 | of preserving the free status of all derivatives of our free software and 256 | of promoting the sharing and reuse of software generally. 257 | 258 | NO WARRANTY 259 | 260 | 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY 261 | FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN 262 | OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 263 | PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED 264 | OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 265 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS 266 | TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE 267 | PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, 268 | REPAIR OR CORRECTION. 269 | 270 | 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 271 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR 272 | REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, 273 | INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING 274 | OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED 275 | TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY 276 | YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER 277 | PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE 278 | POSSIBILITY OF SUCH DAMAGES. 279 | 280 | END OF TERMS AND CONDITIONS 281 | 282 | How to Apply These Terms to Your New Programs 283 | 284 | If you develop a new program, and you want it to be of the greatest 285 | possible use to the public, the best way to achieve this is to make it 286 | free software which everyone can redistribute and change under these terms. 287 | 288 | To do so, attach the following notices to the program. It is safest 289 | to attach them to the start of each source file to most effectively 290 | convey the exclusion of warranty; and each file should have at least 291 | the "copyright" line and a pointer to where the full notice is found. 292 | 293 | 294 | Copyright (C) 295 | 296 | This program is free software; you can redistribute it and/or modify 297 | it under the terms of the GNU General Public License as published by 298 | the Free Software Foundation; either version 2 of the License, or 299 | (at your option) any later version. 300 | 301 | This program is distributed in the hope that it will be useful, 302 | but WITHOUT ANY WARRANTY; without even the implied warranty of 303 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 304 | GNU General Public License for more details. 305 | 306 | You should have received a copy of the GNU General Public License along 307 | with this program; if not, write to the Free Software Foundation, Inc., 308 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 309 | 310 | Also add information on how to contact you by electronic and paper mail. 311 | 312 | If the program is interactive, make it output a short notice like this 313 | when it starts in an interactive mode: 314 | 315 | Gnomovision version 69, Copyright (C) year name of author 316 | Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 317 | This is free software, and you are welcome to redistribute it 318 | under certain conditions; type `show c' for details. 319 | 320 | The hypothetical commands `show w' and `show c' should show the appropriate 321 | parts of the General Public License. Of course, the commands you use may 322 | be called something other than `show w' and `show c'; they could even be 323 | mouse-clicks or menu items--whatever suits your program. 324 | 325 | You should also get your employer (if you work as a programmer) or your 326 | school, if any, to sign a "copyright disclaimer" for the program, if 327 | necessary. Here is a sample; alter the names: 328 | 329 | Yoyodyne, Inc., hereby disclaims all copyright interest in the program 330 | `Gnomovision' (which makes passes at compilers) written by James Hacker. 331 | 332 | , 1 April 1989 333 | Ty Coon, President of Vice 334 | 335 | This General Public License does not permit incorporating your program into 336 | proprietary programs. If your program is a subroutine library, you may 337 | consider it more useful to permit linking proprietary applications with the 338 | library. If this is what you want to do, use the GNU Lesser General 339 | Public License instead of this License. 340 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Historic Lilith emulator 2 | 3 | This is a Lilith emulator which I developed and used in 1983 to 4 | bootstrap a Modula-2 compiler from the Lilith architecture to the Perkin 5 | Elmer 3220 architecture. 6 | 7 | At that time I had a PDP 11/40 available, and a Perkin Elmer 3220 8 | machine, sources for the Modula-2 compiler for the Lilith, and the 9 | binaries (including sources) for the PDP-11 machine. The goal was to 10 | develop a Modula-2 compiler for the Perkin-Elmer 3220 architecture. 11 | 12 | I couldn't crossdevelop that compiler on the PDP 11 as this machine 13 | was available for some limited time only (it was put out of service just 14 | months afterwards I have used it) and because of its painful memory 15 | restrictions. The latter would have enforced me to use a 5-pass 16 | architecture like that of the compiler for the PDP-11 as opposed to the 17 | simpler 4-pass architecture for the Lilith. This required me to 18 | write an emulator. I had the choice between an emulator for the PDP-11 19 | or the Lilith and chose the latter as documentation was available and 20 | the Lilith architecture seemed to be significantly simpler. 21 | 22 | As I had no binaries of the Lilith compiler in Lilith code, I 23 | had to cross compile it on the PDP-11 using the Modula-2 compiler 24 | for the PDP-11: 25 | 26 | ``` 27 | +------------------------+ +------------------------+ 28 | | Modula-2 Lilith | | Modula-2 Lilith | 29 | +------+ +------+----------+------+ +------+ 30 | | Modula-2 | Modula-2 PDP-11 | PDP-11 | 31 | +----------+------+ +------+----------+ 32 | | PDP-11 | 33 | +----------+ 34 | ``` 35 | 36 | In the next step it was possible to generate the Lilith code. 37 | (There was some challenge, though, as this compiler was somewhat 38 | too big for the PDP-11 architecture. This step worked out once 39 | I stripped everything out of the sources which was not required 40 | to let the compiler compile itself.) 41 | 42 | ``` 43 | +------------------------+ +------------------------+ 44 | | Modula-2 Lilith | | Modula-2 Lilith | 45 | +------+ +------+----------+------+ +------+ 46 | | Modula-2 | Modula-2 Lilith | Lilith | 47 | +----------+------+ +------+----------+ 48 | | PDP-11 | 49 | +----------+ 50 | ``` 51 | 52 | The resulting code was moved to the Perkin-Elmer 3220 architecture 53 | and run by emulator which is to be found in the src directory. 54 | 55 | At that time we run UNIX Edition VII from Wollongong on the 56 | Perkin-Elmer 3220 architecture. We had just a C compiler which was 57 | derived from the original C compiler developed by Kernighan and 58 | Ritchie. In consequence, you'll find in the src directory ancient 59 | K&R style. At that time I didn't care much about portability issues 60 | and was just happy that it worked out to bootstrap the Modula-2 61 | compiler. I never intended to polish up this code or use it for 62 | another purpose. It was intended as a temporary project only which 63 | took me one week to develop. 64 | 65 | It is now quite impossible to get this running again under a recent C 66 | compiler or a recent system. No ANSI C compiler will accept this code and 67 | even if everything gets tweaked such that it is accepted, it still won't 68 | run because there exist far too many portability issues. The emulator 69 | depends on an evaluation order generated by the K&R compiler at multiple 70 | occassions which, however, was never guaranteed by C. The only method to 71 | get this code running is to compile and run it under an emulator for this 72 | ancient architecture using an installation of UNIX Edition VII which is 73 | fortunately now freely available. 74 | 75 | Links: 76 | * http://simh.trailing-edge.com/ (The Computer History Simulation Project) 77 | * http://simh.trailing-edge.com/kits/iu7swre.zip (Unix Edition VII) 78 | 79 | I make this code available under the terms of the GNU General Public 80 | License (see the attached file LICENSE) for the purpose of documenting 81 | a historic development process. 82 | 83 | See https://github.com/afborchert/lilith for more infos. 84 | 85 | Andreas F. Borchert 86 | -------------------------------------------------------------------------------- /src/Makefile: -------------------------------------------------------------------------------- 1 | CC= cc 2 | CFLAGS= 3 | OBJS= l_check.o l_end.o l_exec.o l_fs.o l_in.o l_init.o l_load.o l_main.o l_mnem.o l_quit.o l_storage.o l_svc.o l_trace.o 4 | 5 | all: lilith 6 | 7 | lilith: ${OBJS} 8 | ${CC} -o lilith ${OBJS} 9 | 10 | clean: 11 | rm -f ${OBJS} 12 | -------------------------------------------------------------------------------- /src/READ_ME: -------------------------------------------------------------------------------- 1 | Auswertung eines Back-Trace von Lilith: 2 | 3 | ( 1 ) Uebersetze l_load.c mit -DTRACE . 4 | (Die anderen Module unveraendert lassen.) 5 | ( 2 ) Starte folgendes Kommando: 6 | 7 | a.out -h 90 -s 20 -c 25 Base.m2c 2>OUT 8 | 9 | wobei man als Sourcefile ein minimales 10 | Modula-2 Programm angibt. 11 | ( 3 ) Man editiere OUT so, dass nur drei Zahlen- 12 | kolonnen uebrigbleiben. 13 | 14 | ( 4 ) Starte folgendes Kommando: 15 | 16 | ../mle/list >OUT2 17 | 18 | In OUT2 ist nun eine uebersichtliche Liste mit 19 | den Anfangsaddressen aller Module. 20 | (Alle Addressen in oktaler Darstellung). 21 | 22 | ( 5 ) Per 23 | 24 | cd ../mle 25 | make mcl_l >MCL_L 26 | 27 | erhalten Sie eine Liste der Modulnummern. 28 | Nun koennen Sie in Verbindung von OUT2 und 29 | MCL_L die einzelnen Module des Backtraces 30 | ermitteln. 31 | (F-Register * 4 = Moduladdresse) 32 | ( 6 ) Um die Offsets der einzelnen Prozeduren des 33 | Moduls zu ermitteln genuegt 34 | 35 | mcd name.m2 | grep proc 36 | 37 | (Vergleich mit dem PC-Register). 38 | 39 | Wie Sie sehen ist es besser, solche Fehler erst gar nicht zu verursachen... 40 | 41 | Vor cc -DTRACE *.c wird gewarnt, der Trace-Output ist extrem umfangreich 42 | und das Ausfuehrungstempo wird sehr langsam. 43 | -------------------------------------------------------------------------------- /src/l.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Lilith 3 | * 4 | * (c) Andreas Borchert, 1983 5 | */ 6 | 7 | #define TRUE 1 8 | #define FALSE 0 9 | 10 | typedef unsigned short word; 11 | 12 | /* FrameTypes bei loadfiles */ 13 | 14 | #define EOFSY 0 15 | #define xBASE 0300 16 | #define xDATATEXT 0301 17 | #define xCODETEXT 0302 18 | #define xMODULE 0303 19 | 20 | #define CALLOC(ptr,n,s) { if ( (ptr = calloc(n,s)) == NULL )\ 21 | quit("No space available"); } 22 | 23 | #define DFT 040 24 | #define TLC 016 25 | 26 | #define isvisible(ch) ((ch)>=' '&&(ch)<='~') 27 | -------------------------------------------------------------------------------- /src/l_check.c: -------------------------------------------------------------------------------- 1 | #ifdef LT 2 | # define TRACE 3 | #endif 4 | #ifdef TRACE 5 | 6 | /* 7 | * bei TRACE wird folgende Funktion nach jedem Befehl 8 | * ausgefuehrt 9 | */ 10 | #include 11 | #include 12 | #include "l.h" 13 | 14 | 15 | extern word *stack; 16 | extern word G; 17 | extern word PC; 18 | extern word L; 19 | 20 | check () 21 | { 22 | if ( PC == 03651 ) { 23 | trace("NextCh : ch = `%c' , (%o)\n",stack[G+7],stack[G+7]); 24 | fs_show ( &stack[041764] ); 25 | } 26 | } 27 | 28 | #endif TRACE 29 | -------------------------------------------------------------------------------- /src/l_end.c: -------------------------------------------------------------------------------- 1 | #ifdef LT 2 | # define TRACE 3 | #endif LT 4 | #ifdef TRACE 5 | #include 6 | #include "l.h" 7 | 8 | extern word *stack; 9 | extern int stacksize; 10 | extern int datasize; 11 | extern int heapsize; 12 | 13 | eox () 14 | { 15 | int adr; 16 | int ch; 17 | int cmd = 'o'; 18 | int index; 19 | 20 | printf("\n\nEnd of execution....\n"); 21 | do { 22 | if ( scanf("%o",&adr) ) 23 | index = adr; 24 | while ( (ch = getchar()) == ' ' ) 25 | ; 26 | if ( ch != '\n' ) 27 | cmd = ch; 28 | if ( index >= stacksize+heapsize+datasize ) 29 | index = 0; 30 | else if ( index < 0 ) 31 | index = 0; 32 | switch ( cmd ) { 33 | case 'o' : printf("%5o %5o ",index++,stack[index]); break; 34 | case 's' : printf("%5o `%s' ",index,&stack[index]); 35 | while ( stack[index] && index < stacksize+datasize+heapsize ) 36 | ++index; 37 | ++index; 38 | break; 39 | case 'c' : printf("%5o `%c' `%c' %3o %3o ", 40 | index, 41 | stack[index] / 0x100, 42 | stack[index] % 0x100, 43 | stack[index] / 0x100, 44 | stack[index] % 0x100 ); 45 | ++index; 46 | break; 47 | case 'x' : exit(0); 48 | default : printf("??? "); cmd = 'o'; 49 | break; 50 | } 51 | } 52 | while ( 1 ); 53 | } 54 | 55 | #endif TRACE 56 | -------------------------------------------------------------------------------- /src/l_exec.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Lilith 3 | * 4 | * siehe : Appendix 1 of the yellow report : 5 | * N.Wirth. The Personal Computer Lilith. 6 | * Institut fuer Informatik, ETH. Report 40, 1981. 7 | */ 8 | 9 | #include 10 | #include 11 | #include "l.h" 12 | 13 | extern int no_checks; 14 | 15 | word *stack; 16 | char *code; 17 | int datasize; 18 | int stacksize; 19 | int codesize; 20 | 21 | word PC; /* program counter */ 22 | word IR; /* instruction register */ 23 | word F; /* code frame base address */ 24 | word G; /* data frame base address */ 25 | word H; /* stack limit address */ 26 | word L; /* local segment address */ 27 | word S; /* stack pointer */ 28 | word P; /* process base address */ 29 | word M; /* process interrupt mask */ 30 | word REQ; /* interrupt request */ 31 | word ReqNo; /* request number, 8..15 */ 32 | 33 | int bootflag = TRUE; 34 | #ifdef TRACE 35 | int act_mod; /* aktuelles Modul */ 36 | int may_print; 37 | extern char *mnem[]; 38 | #define RANGE TRUE 39 | #undef LT 40 | #endif 41 | 42 | #ifdef LT 43 | int may_print; 44 | extern char *mnem[]; 45 | word rge_low,rge_high; 46 | int act_mod; 47 | int aux; 48 | #define RANGE (F*4+PC>=rge_low && F*4+PC<=rge_high) 49 | # define TRACE 50 | #endif 51 | 52 | word 53 | next () 54 | { 55 | ++PC; 56 | #ifdef TRACE 57 | if ( may_print && RANGE ) 58 | trace(" %3o",code [ 4*F+PC-1 ]); 59 | #endif 60 | return (word) code [ 4*F+PC-1 ]; 61 | } 62 | 63 | short 64 | snext () 65 | { 66 | short val; 67 | 68 | ++PC; 69 | val = (short) code [ 4*F+PC-1 ] & 0x7F; 70 | if ( code [ 4*F+PC-1 ] & 0x80 ) val |= 0xFF80; 71 | #ifdef TRACE 72 | if ( may_print && RANGE ) 73 | trace(" %3o",val); 74 | #endif 75 | return val; 76 | } 77 | 78 | word 79 | next2 () 80 | { 81 | PC += 2; 82 | #ifdef TRACE 83 | if ( RANGE ) 84 | trace(" %5o",code [ 4*F+PC-2 ]*0x100 + code [ 4*F+PC-1 ]); 85 | #endif 86 | return code [ 4*F+PC-2 ]*0x100 + code [ 4*F+PC-1 ]; 87 | } 88 | 89 | /* 90 | * ExpressionStack 91 | */ 92 | 93 | static int sp = 0; 94 | word a[16]; 95 | 96 | #ifdef TRACE 97 | showstack() 98 | { 99 | int index; 100 | 101 | if ( RANGE ) 102 | for ( index = 0 ; index < sp ; ++index ) 103 | trace("a[%2d] = %5o\n",index,a[index]); 104 | } 105 | #endif TRACE 106 | 107 | push ( x ) 108 | word x; 109 | { 110 | #ifdef TRACE 111 | if ( sp >= 16 ) 112 | crash("Expression Stack Overflow"); 113 | #endif TRACE 114 | a[sp++] = x; 115 | } 116 | 117 | word 118 | pop () 119 | { 120 | #ifdef TRACE 121 | if ( empty() ) 122 | crash("Expression Stack Underflow"); 123 | #endif TRACE 124 | return a[--sp]; 125 | } 126 | 127 | dpush ( d ) 128 | long d; 129 | { 130 | union { 131 | long f; 132 | word w[2]; 133 | } x; 134 | 135 | x.f = d; 136 | push ( x.w[0] ); 137 | push ( x.w[1] ); 138 | } 139 | 140 | long 141 | dpop () 142 | { 143 | union { 144 | long f; 145 | word w[2]; 146 | } x; 147 | 148 | x.w[1] = pop(); 149 | x.w[2] = pop(); 150 | return x.f; 151 | } 152 | 153 | empty () 154 | { 155 | return sp == 0; 156 | } 157 | 158 | mark ( x , external ) 159 | word x; 160 | int external; 161 | { 162 | word i; 163 | 164 | i = S; 165 | stack[S++] = x; /* static link */ 166 | stack[S++] = L; /* dynamic link */ 167 | if ( external ) 168 | stack[S] = PC | 0x8000; 169 | else 170 | stack[S] = PC; 171 | S += 2; 172 | L = i; 173 | } 174 | 175 | saveexpstack () 176 | { 177 | word c; 178 | 179 | c = 0; 180 | while ( ! empty() ) { 181 | stack[S++] = pop(); 182 | ++c; 183 | } 184 | stack[S++] = c; 185 | } 186 | 187 | restoreexpstack () 188 | { 189 | word c; 190 | 191 | c = stack[--S]; 192 | while ( c > 0 ) { 193 | --c; 194 | push ( stack[--S] ); 195 | } 196 | } 197 | 198 | saveregs () 199 | { 200 | saveexpstack(); 201 | stack[P ] = G; stack[P+1] = L; 202 | stack[P+2] = PC;stack[P+3] = M; 203 | stack[P+4] = S; stack[P+5] = H+24; 204 | } 205 | 206 | restoreregs(changemask) 207 | int changemask; 208 | { 209 | G = stack[P]; F = stack[G]; 210 | L = stack[P+1]; 211 | if ( ! bootflag ) 212 | PC = stack[P+2]; 213 | else { 214 | PC = 0; 215 | PC = next2(); /* proc # 0 wird zuerst aufgerufen */ 216 | stack[P+2] = PC; 217 | } 218 | if ( changemask ) 219 | M = stack[P+3]; 220 | S = stack[P+4]; H = stack[P+5] - 24; 221 | if ( ! bootflag ) 222 | restoreexpstack(); 223 | } 224 | 225 | transfer(changemask,to,from) 226 | int changemask; 227 | word to,from; 228 | { 229 | word j; 230 | 231 | #ifdef TRACE 232 | trace("transfer: to = %o, from = %o\n",to,from); 233 | #endif 234 | j = stack[to]; 235 | saveregs(); 236 | stack[from] = P; 237 | P = j; 238 | restoreregs(changemask); 239 | } 240 | 241 | trap(n) 242 | word n; 243 | { 244 | crash("\n\nTRAP %o\n\n",n); 245 | if ( ! (0x0001<= datasize+stacksize ) 285 | quit("stack segment overflow"); 286 | */ 287 | #ifdef TRACE 288 | may_print = FALSE; 289 | #endif 290 | IR = next(); 291 | #ifdef TRACE 292 | may_print = TRUE; 293 | if ( RANGE ) 294 | trace("%5o %5o %5o %5o %-5s",4*F+PC-1,(PC-1)/2,PC-1,IR,mnem[IR]); 295 | #endif 296 | if ( IR < 020 ) /* LI0 - LI15 */ 297 | push ( IR % 16 ); 298 | else if ( IR < 040 ) switch ( IR ) { 299 | case 020 : /* LIB */ 300 | push(next()); break; 301 | case 022 : /* LIW */ 302 | push(next2()); break; 303 | case 023 : /* LID */ 304 | push(next2()); push(next2()); break; 305 | case 024 : /* LLA */ 306 | push(L+next()); break; 307 | case 025 : /* LGA */ 308 | push(G+next()); break; 309 | case 026 : /* LSA */ 310 | push(pop()+next()); break; 311 | case 027 : /* LEA */ 312 | i = next(); 313 | j = next(); 314 | push(stack[DFT+i]+j); break; 315 | case 030 : /* JPC */ 316 | if ( ! pop() ) { 317 | i = next2(); 318 | PC += i-2; 319 | } 320 | else 321 | PC += 2; 322 | break; 323 | case 031 : /* JP */ 324 | i = next2(); 325 | PC += i-2; break; 326 | case 032 : /* JPFC */ 327 | if ( ! pop() ) 328 | PC += next() -1; 329 | else 330 | ++PC; 331 | break; 332 | case 033 : /* JPF */ 333 | PC += next() -1; break; 334 | case 034 : /* JPBC */ 335 | if ( ! pop() ) 336 | PC -= next() +1; 337 | else 338 | ++PC; 339 | break; 340 | case 035 : /* JPB */ 341 | PC -= next() +1; break; 342 | case 036 : /* ORJP */ 343 | if ( ! pop() ) 344 | ++PC; 345 | else { 346 | push(1); 347 | PC += next() -1; 348 | } 349 | break; 350 | case 037 : /* ANDJP */ 351 | if ( ! pop() ) { 352 | push(0); 353 | PC += next() -1; 354 | } 355 | else 356 | ++PC; 357 | break; 358 | } 359 | else if ( IR < 044 ) switch ( IR ) { 360 | case 040 : /* LLW */ 361 | push(stack[L+next()]); break; 362 | case 041 : /* LLD */ 363 | i = L+next(); 364 | push(stack[i]); 365 | push(stack[i+1]); 366 | break; 367 | case 042 : /* LEW */ 368 | i = next(); 369 | j = next(); 370 | push(stack[stack[DFT+i]+j]); break; 371 | case 043 : /* LED */ 372 | j = next(); 373 | i = stack[DFT+j]+next(); 374 | push(stack[i]); 375 | push(stack[i+1]); 376 | break; 377 | } 378 | else if ( IR < 060 ) /* LLW4 - LLW15 */ 379 | push(stack[L + IR % 16]); 380 | else if ( IR < 064 ) switch ( IR ) { 381 | case 060 : /* SLW */ 382 | stack[L+next()] = pop(); break; 383 | case 061 : /* SLD */ 384 | i = L+next(); 385 | stack[i+1] = pop(); 386 | stack[i] = pop(); 387 | break; 388 | case 062 : /* SEW */ 389 | i = next(); 390 | j = next(); 391 | stack[stack[DFT+i]+j] = pop(); break; 392 | case 063 : /* SED */ 393 | j = next(); 394 | i = stack[DFT+j]+next(); 395 | stack[i+1] = pop(); stack[i] = pop(); 396 | break; 397 | } 398 | else if ( IR < 0100 ) /* SLW4-SLW15 */ 399 | stack[L+ IR % 16] = pop(); 400 | else if ( IR < 0102 ) switch ( IR ) { 401 | case 0100 : /* LGW */ 402 | push(stack[G+next()]); break; 403 | case 0101 : /* LGD */ 404 | i = next() + G; 405 | push(stack[i]); 406 | push(stack[i+1]); 407 | break; 408 | } 409 | else if ( IR < 0120 ) /* LGW2 - LGW15 */ 410 | push(stack[G+ IR % 16]); 411 | else if ( IR < 0122 ) switch ( IR ) { 412 | case 0120 : /* SGW */ 413 | stack[G+next()] = pop(); break; 414 | case 0121 : /* SGD */ 415 | i = G+next(); 416 | stack[i+1] = pop(); 417 | stack[i] = pop(); 418 | break; 419 | } 420 | else if ( IR < 0140 ) /* SGW2 - SGW15 */ 421 | stack[G + IR % 16] = pop(); 422 | else if ( IR < 0160 ) /* LSW0 - LSW15 */ 423 | push(stack[pop() + IR % 16]); 424 | else if ( IR < 0200 ) { /* SSW0 - SSW15 */ 425 | k = pop(); 426 | i = pop() + IR % 16; 427 | stack[i] = k; 428 | } 429 | else if ( IR < 0240 ) switch ( IR ) { 430 | case 0200 : /* LSW */ 431 | i = pop() + next(); 432 | push(stack[i]); 433 | break; 434 | case 0201 : /* LSD */ 435 | i = pop() + next(); 436 | push(stack[i]); 437 | push(stack[i+1]); 438 | break; 439 | case 0202 : /* LSDO */ 440 | i = pop(); 441 | push ( stack[i] ); 442 | push ( stack[i+1] ); 443 | break; 444 | case 0203 : /* LXFW */ 445 | k = pop() + pop() * 4; 446 | push(stack[k]); 447 | break; 448 | case 0204 : /* LSTA */ 449 | push(stack[G+2]+next()); break; 450 | case 0205 : /* LXB */ 451 | i = pop(); 452 | j = pop(); 453 | k = stack[ j + i/2 ]; 454 | if ( i % 2 == 0 ) 455 | push ( k / 0x100 ); 456 | else 457 | push ( k % 0x100 ); 458 | break; 459 | case 0206 : /* LXW */ 460 | i = pop() + pop(); 461 | push(stack[i]); 462 | break; 463 | case 0207 : /* LXD */ 464 | i = 2*pop()+pop(); 465 | push(stack[i]); 466 | push(stack[i+1]); 467 | break; 468 | case 0210 : /* DADD */ 469 | y = dpop(); 470 | x = dpop(); 471 | dpush(x+y); 472 | break; 473 | case 0211 : /* DSUB */ 474 | y = dpop(); 475 | x = dpop(); 476 | dpush(x-y); 477 | break; 478 | case 0212 : /* DMUL */ 479 | j = pop(); 480 | i = pop(); 481 | x = (long) (i * j); 482 | dpush(x); 483 | break; 484 | case 0213 : /* DDIV */ 485 | j = pop(); 486 | x = dpop(); 487 | k = ((word) x ) / j; 488 | i = ((word) x ) / j; 489 | push(i); 490 | push(k); 491 | break; 492 | case 0216 : /* DSHL */ 493 | x = dpop(); 494 | x <<= 1; 495 | dpush(x); 496 | break; 497 | case 0217 : /* DSHR */ 498 | x = dpop(); 499 | x >>= 1; 500 | dpush(x); 501 | break; 502 | case 0220 : /* SSW */ 503 | k = pop(); 504 | i = pop() + next(); 505 | stack[i] = k; 506 | break; 507 | case 0221 : /* SSD */ 508 | k = pop(); 509 | j = pop(); 510 | i = pop() + next(); 511 | stack[i] = j; 512 | stack[i+1] = k; 513 | break; 514 | case 0222 : /* SSD0 */ 515 | k = pop(); 516 | j = pop(); 517 | i = pop(); 518 | stack[i] = j; 519 | stack[i+1] = k; 520 | break; 521 | case 0223 : /* SXFW */ 522 | i = pop(); 523 | k = pop() + pop()*4; 524 | stack[k] = i; 525 | break; 526 | case 0224 : /* TS */ 527 | i = pop(); 528 | push(stack[i]); 529 | stack[i] = 1; 530 | break; 531 | case 0225 : /* SXB */ 532 | k = pop(); 533 | i = pop(); 534 | j = pop() + i / 2; 535 | if ( i % 2 == 0 ) 536 | stack[j] = k * 0x100 + stack[j] % 0x100; 537 | else 538 | stack[j] = (stack[j]/0x100) * 0x100 + k; 539 | break; 540 | case 0226 : /* SXW */ 541 | k = pop(); 542 | i = pop() + pop(); 543 | stack[i] = k; 544 | break; 545 | case 0227 : /* SXD */ 546 | k = pop(); 547 | j = pop(); 548 | i = 2 * pop() + pop(); 549 | stack[i] = j; 550 | stack[i+1] = k; 551 | break; 552 | case 0230 : /* FADD */ 553 | fy = dpop(); 554 | fx = dpop(); 555 | dpush(fx+fy); 556 | break; 557 | case 0231 : /* FSUB */ 558 | fy = dpop(); 559 | fx = dpop(); 560 | dpush(fx-fy); 561 | break; 562 | case 0232 : /* FMUL */ 563 | fy = dpop(); 564 | fx = dpop(); 565 | dpush(fx*fy); 566 | break; 567 | case 0233 : /* FDIV */ 568 | fy = dpop(); 569 | fx = dpop(); 570 | dpush(fx/fy); 571 | break; 572 | case 0234 : /* FCMP */ 573 | fx = dpop(); 574 | fy = dpop(); 575 | push( fx < fy ); 576 | push( fx > fy ); 577 | break; 578 | case 0235 : /* FABS */ 579 | fx = dpop(); 580 | dpush( fx >= 0 ? fx : -fx); 581 | break; 582 | case 0236 : /* FNEG */ 583 | dpush(-dpop()); break; 584 | case 0237 : /* FFCT */ 585 | switch ( next() ) { 586 | case 0 : dpush( (float) pop() ); break; 587 | case 1 : dpush( (float) pop() ); break; 588 | case 2 : push ( (word) dpop() ); break; 589 | case 3 : crash("FFCT 3 not yet implemented"); break; 590 | default: crash("FFCT %1d: ill. argument"); break; 591 | } 592 | break; 593 | } 594 | else if ( IR < 0300 ) switch ( IR ) { 595 | case 0240 : /* READ */ 596 | crash("READ not implemented"); break; 597 | case 0241 : /* WRITE */ 598 | crash("WRITE not implemented"); break; 599 | case 0242 : /* DSKR */ 600 | crash("DSKR not implemented"); break; 601 | case 0243 : /* DSKW */ 602 | crash("DSKW not implemented"); break; 603 | case 0244 : /* SETRK */ 604 | crash("SETRK not implemented"); break; 605 | case 0245 : /* UCHK */ 606 | k = pop(); 607 | j = pop(); 608 | i = pop(); 609 | push(i); 610 | if (no_checks) break; 611 | if ( i < j || i > k ) 612 | crash("UCHK fails: %o [%o..%o]\n",i,j,k); 613 | break; 614 | case 0246 : /* SVC - supervisor call */ 615 | svc ( next() ); break; 616 | case 0247 : /* SYS */ 617 | crash("SYS not implemented"); break; 618 | case 0250 : /* ENTP */ 619 | stack[L+3] = M; 620 | M = 0xFFFF << (16-next()); 621 | break; 622 | case 0251 : /* EXP */ 623 | M = stack[L+3]; 624 | break; 625 | case 0252 : /* ULSS */ 626 | j = pop(); 627 | i = pop(); 628 | push ( i < j ); 629 | break; 630 | case 0253 : /* ULEQ */ 631 | j = pop(); 632 | i = pop(); 633 | push ( i <= j ); 634 | break; 635 | case 0254 : /* UGTR */ 636 | j = pop(); 637 | i = pop(); 638 | push ( i > j ); 639 | break; 640 | case 0255 : /* UGEQ */ 641 | j = pop(); 642 | i = pop(); 643 | push ( i >= j ); 644 | break; 645 | case 0256 : /* TRA */ 646 | transfer(next(),pop(),pop()); break; 647 | case 0257 : /* RDS */ 648 | k = pop(); 649 | i = next(); 650 | do { 651 | stack[k++] = next2(); 652 | --i; 653 | } 654 | while ( i >= 0 ); 655 | break; 656 | case 0260 : /* LODFW */ 657 | i = pop(); 658 | restoreexpstack(); 659 | push(i); 660 | break; 661 | case 0261 : /* LODFD */ 662 | i = pop(); 663 | j = pop(); 664 | restoreexpstack(); 665 | push(j); 666 | push(i); 667 | break; 668 | case 0262 : /* STORE */ 669 | saveexpstack(); break; 670 | case 0263 : /* STOFV */ 671 | i = pop(); 672 | saveexpstack(); 673 | stack[S++] = i; 674 | break; 675 | case 0264 : /* STOT */ 676 | stack[S++] = pop(); break; 677 | case 0265 : /* COPT */ 678 | i = pop(); 679 | push(i); 680 | push(i); 681 | break; 682 | case 0266 : /* DECS */ 683 | --S; break; 684 | case 0267 : /* PCOP */ 685 | stack[L+next()] = S; 686 | sz = pop(); k = S+sz; adr = pop(); 687 | while ( sz > 0 ) { 688 | stack[S++] = stack[adr++]; 689 | --sz; 690 | } 691 | break; 692 | case 0270 : /* UADD */ 693 | j = pop(); 694 | i = pop(); 695 | push(i+j); 696 | break; 697 | case 0271 : /* USUB */ 698 | j = pop(); 699 | i = pop(); 700 | push(i-j); 701 | break; 702 | case 0272 : /* UMUL */ 703 | j = pop(); 704 | i = pop(); 705 | push ( i * j ); 706 | break; 707 | case 0273 : /* UDIV */ 708 | j = pop(); 709 | i = pop(); 710 | push ( i / j ); 711 | break; 712 | case 0274 : /* UMOD */ 713 | j = pop(); 714 | i = pop(); 715 | push ( i % j ); 716 | break; 717 | case 0275 : /* ROR */ 718 | i = pop() % 16; 719 | j = pop(); 720 | k = (j>>i) | ((j&(0xFFFF>>(16-i)))<<(16-i)); 721 | push(k); 722 | break; 723 | case 0276 : /* SHL */ 724 | i = pop() % 16; 725 | j = pop(); 726 | k = j << i; 727 | push(k); 728 | break; 729 | case 0277 : /* SHR */ 730 | i = pop() % 16; 731 | j = pop(); 732 | k = j >> i; 733 | push(k); 734 | break; 735 | } 736 | else if ( IR < 0340 ) switch ( IR ) { 737 | case 0300 : /* FOR1 */ 738 | i = next(); 739 | hi = pop(); 740 | low = pop(); 741 | adr = pop(); 742 | k = PC + next2() - 2; 743 | if ( (!i && low <= hi) || (i && low >= hi) ) { 744 | stack[adr] = low; 745 | stack[S++] = adr; 746 | stack[S++] = hi; 747 | } 748 | else 749 | PC = k; 750 | break; 751 | case 0301 : /* FOR2 */ 752 | hi = stack[S-1]; 753 | adr = stack[S-2]; 754 | ssz = snext(); 755 | #ifdef TRACE 756 | trace(" FOR2: ssz = %d\n", ssz); 757 | trace("\t\t\t\tFOR2: hi = %d, stack[adr] = %d.\n",hi, stack[adr]); 758 | #endif TRACE 759 | k = PC + next2()-2; 760 | si = stack[adr]+ssz; 761 | if ( (ssz >= 0 && si>hi) || (ssz <= 0 && si < hi) ) 762 | S -= 2; 763 | else { 764 | stack[adr] = si; 765 | PC = k; 766 | } 767 | break; 768 | case 0302 : /* ENTC */ 769 | PC += next2()-2; 770 | k = pop(); 771 | low = next2(); 772 | hi = next2(); 773 | stack[S++] = PC + 2*(hi-low) + 4; 774 | if ( k >= low && k <= hi ) 775 | PC += 2*(k-low+1); 776 | PC += next2()-2; 777 | break; 778 | case 0303 : /* EXC */ 779 | PC = stack[--S]; break; 780 | case 0304 : /* TRAP */ 781 | trap(pop()); break; 782 | case 0305 : /* CHK */ 783 | sk = pop(); 784 | sj = pop(); 785 | si = pop(); 786 | push(si); 787 | if ( no_checks ) break; 788 | if ( si < sj || si > sk ) 789 | crash("CHK fails: %o [%o..%o]",si,sj,sk); 790 | break; 791 | case 0306 : /* CHKZ */ 792 | k = pop(); 793 | i = pop(); 794 | push(i); 795 | if ( no_checks ) break; 796 | if ( i > k ) 797 | crash("CHKZ fails: %o > %o",i,k); 798 | break; 799 | case 0307 : /* CHKS */ 800 | si = pop(); 801 | push(si); 802 | if ( no_checks ) break; 803 | if ( si < 0 ) 804 | crash("CHKS fails: -%o < 0",-si); 805 | break; 806 | case 0310 : /* EQL */ 807 | push( pop() == pop() ); break; 808 | case 0311 : /* NEQ */ 809 | push ( pop() != pop() ); break; 810 | case 0312 : /* LSS */ 811 | sj = pop(); 812 | si = pop(); 813 | push( si < sj); 814 | break; 815 | case 0313 : /* LEQ */ 816 | sj = pop(); 817 | si = pop(); 818 | push( si <= sj); 819 | break; 820 | case 0314 : /* GTR */ 821 | sj = pop(); 822 | si = pop(); 823 | push( si > sj ); 824 | break; 825 | case 0315 : /* GEQ */ 826 | sj = pop(); 827 | si = pop(); 828 | push( si >= sj ); 829 | break; 830 | case 0316 : /* ABS */ 831 | si = pop(); 832 | push( si >= 0 ? si : -si); break; 833 | case 0317 : /* NEG */ 834 | si = pop(); 835 | push(-si); break; 836 | case 0320 : /* OR */ 837 | j = pop(); 838 | i = pop(); 839 | push( i | j ); 840 | break; 841 | case 0321 : /* XOR */ 842 | j = pop(); 843 | i = pop(); 844 | push ( i ^ j ); 845 | break; 846 | case 0322 : /* AND */ 847 | j = pop(); 848 | i = pop(); 849 | push( i & j ); 850 | break; 851 | case 0323 : /* COM */ 852 | push ( ~ pop() ); 853 | break; 854 | case 0324 : /* IN */ 855 | j = pop(); 856 | i = pop(); 857 | push( i <= 15 && ((0x8000>>i) & j) ); 858 | break; 859 | case 0325 : /* LIN */ 860 | push( 0xFFFF ); break; 861 | case 0326 : /* MSK */ 862 | i = pop() % 16; 863 | push( 0xFFFF << (i-16) ); 864 | break; 865 | case 0327 : /* NOT */ 866 | push ( ! pop() ); 867 | break; 868 | case 0330 : /* ADD */ 869 | sj = pop(); 870 | si = pop(); 871 | push( si + sj ); 872 | break; 873 | case 0331 : /* SUB */ 874 | sj = pop(); 875 | si = pop(); 876 | push( si - sj ); 877 | break; 878 | case 0332 : /* MUL */ 879 | sj = pop(); 880 | si = pop(); 881 | push( si * sj ); 882 | break; 883 | case 0333 : /* DIV */ 884 | sj = pop(); 885 | si = pop(); 886 | push( si / sj ); 887 | break; 888 | case 0334 : /* MOD */ 889 | sj = pop(); 890 | si = pop(); 891 | push( si % sj ); 892 | break; 893 | case 0335 : /* BIT */ 894 | j = pop(); 895 | k = 0x8000 >> j; 896 | push(k); 897 | break; 898 | case 0336 : /* NOP */ 899 | break; 900 | case 0337 : /* MOVF */ 901 | i = pop(); 902 | j = pop() + pop()*4; 903 | k = pop() + pop()*4; 904 | while ( i > 0 ) { 905 | stack[k++] = stack[j++]; 906 | --i; 907 | } 908 | break; 909 | } 910 | else if ( IR < 0361 ) switch ( IR ) { 911 | case 0340 : /* MOV */ 912 | k = pop(); 913 | j = pop(); 914 | i = pop(); 915 | while ( k > 0 ) { 916 | stack[i++] = stack[j++]; 917 | --k; 918 | } 919 | break; 920 | case 0341 : /* CMP */ 921 | k = pop(); 922 | j = pop(); 923 | i = pop(); 924 | if ( k == 0 ) { 925 | push(0); 926 | push(0); 927 | } 928 | else { 929 | while ( stack[i] != stack[j] && 930 | k > 0 ) { 931 | ++i; ++j; --k; 932 | } 933 | push(stack[i]); 934 | push(stack[j]); 935 | } 936 | break; 937 | case 0342 : /* DDT */ 938 | crash("DDT not implemented"); break; 939 | case 0343 : /* REPL */ 940 | crash("REPL not implemented"); break; 941 | case 0344 : /* BBLT */ 942 | crash("BBLT not implemented"); break; 943 | case 0345 : /* DCH */ 944 | crash("DCH not implemented"); break; 945 | case 0346 : /* UNPK */ 946 | crash("UNPK not implemented"); break; 947 | case 0347 : /* PACK */ 948 | crash("PACK not implemented"); break; 949 | case 0350 : /* GB */ 950 | i = L; 951 | j = next(); 952 | do { 953 | i = stack[i]; 954 | --j; 955 | } 956 | while ( j > 0 ); 957 | push(i); 958 | break; 959 | case 0351 : /* GB1 */ 960 | push(stack[L]); break; 961 | case 0352 : /* ALLOC */ 962 | i = pop(); 963 | push(S); 964 | S += i; 965 | break; 966 | case 0353 : /* ENTR */ 967 | i = next(); 968 | S += i; 969 | break; 970 | case 0354 : /* RTN */ 971 | S = L; 972 | L = stack[S+1]; 973 | i = stack[S+2]; 974 | if ( i & 0x8000 ) { 975 | G = stack[S]; 976 | F = stack[G]; 977 | PC = i & 0x7FFF; 978 | } 979 | else 980 | PC = i; 981 | #ifdef TRACE 982 | if ( RANGE ) 983 | trace("\n\nG = %o, L = %o, S = %o, F = %o\n",G,L,S,F); 984 | #endif TRACE 985 | if ( !PC ) /* RTN von module 1 */ 986 | #ifdef TRACE 987 | { 988 | trace("\nend of execution\n"); 989 | eox(); 990 | #endif TRACE 991 | exit(0); 992 | #ifdef TRACE 993 | } 994 | #endif TRACE 995 | break; 996 | case 0355 : /* CX */ 997 | j = next(); 998 | i = next(); 999 | #ifdef TRACE 1000 | trace("\nG = %o, L = %o, S = %o, F = %o\n",G,L,S,F); 1001 | act_mod = j; 1002 | trace("\nmodule # %3o, proc # %3o\n",act_mod,i); 1003 | showstack(); 1004 | #endif 1005 | mark(G,TRUE); 1006 | G = stack[DFT+j]; 1007 | assert(G >= 0200); 1008 | F = stack[G]; 1009 | assert( ! (G > 0200 && F == 0) ); 1010 | PC = 2*i; 1011 | PC = next2(); 1012 | break; 1013 | case 0356 : /* CI */ 1014 | i = next(); 1015 | mark(pop(),FALSE); 1016 | PC = 2*i; 1017 | PC = next2(); 1018 | break; 1019 | case 0357 : /* CF */ 1020 | i = stack[S-1]; 1021 | mark(G,TRUE); 1022 | j = i / 0x100; 1023 | G = stack[DFT+j]; 1024 | F = stack[G]; 1025 | PC = 2 * ( i % 0x100 ); 1026 | PC = next2(); 1027 | break; 1028 | case 0360 : /* CL */ 1029 | i = next(); 1030 | #ifdef TRACE 1031 | trace("module # %3o, proc # %3o\n",act_mod,i); 1032 | showstack(); 1033 | #endif 1034 | mark(L,FALSE); 1035 | PC = 2*i; 1036 | PC = next2(); 1037 | } 1038 | else { /* CL1 - CL15 */ 1039 | #ifdef TRACE 1040 | trace("module # %3o, proc # %3o\n",act_mod,IR % 16); 1041 | showstack(); 1042 | #endif 1043 | mark(L,FALSE); 1044 | PC = 2*(IR % 16); 1045 | PC = next2(); 1046 | } 1047 | #ifdef TRACE 1048 | if ( RANGE ) { 1049 | check(); 1050 | trace("\n"); 1051 | } 1052 | #endif 1053 | } 1054 | while ( 1 ); 1055 | } 1056 | 1057 | crash ( s , p1 , p2 , p3 , p4 , p5 , p6 ) 1058 | { 1059 | CloseAll(); 1060 | fprintf(stderr,"\nLilith crashes ...\n"); 1061 | fprintf(stderr,s,p1,p2,p3,p4,p5,p6); 1062 | fprintf(stderr,"\n"); 1063 | fprintf(stderr,"IR = %o\n",IR); 1064 | fprintf(stderr,"F = %o\n",F); 1065 | fprintf(stderr,"PC = %o\n",PC); 1066 | backtrace(L,F); 1067 | quit("CRASH"); 1068 | } 1069 | 1070 | backtrace (L,F) 1071 | register word L,F; 1072 | { 1073 | register word S, i, PC; 1074 | register word looping; 1075 | 1076 | looping = 0; 1077 | fprintf(stderr,"*** BACKTRACE ***\n"); 1078 | fprintf(stderr,"S L F PC\n"); 1079 | fprintf(stderr,"-----------------------\n"); 1080 | 1081 | /* 1082 | * Simulation aller moeglichen RTN-Befehle 1083 | */ 1084 | 1085 | do { 1086 | S = L; 1087 | L = stack[S+1]; 1088 | i = stack[S+2]; 1089 | if ( i & 0x8000 ) { 1090 | G = stack[S]; 1091 | F = stack[G]; 1092 | PC = i & 0x7FFF; 1093 | } 1094 | else 1095 | PC = i; 1096 | fprintf(stderr,"%5o %5o %5o %5o\n",S,L,F,PC); 1097 | } 1098 | while ( PC && looping++ < 100 ); 1099 | } 1100 | -------------------------------------------------------------------------------- /src/l_fs.c: -------------------------------------------------------------------------------- 1 | #ifdef LT 2 | #define TRACE 3 | #endif LT 4 | /* 5 | * FileSystem for Lilith 6 | */ 7 | 8 | #include 9 | #include "l.h" 10 | 11 | #define ER 0x8000 12 | #define EF 0x4000 13 | #define RD 0x2000 14 | #define WR 0x1000 15 | #define AG 0x0800 16 | #define BYTEMODE 0x0400 17 | 18 | #define BUFSIZE 512 19 | 20 | extern word *stack; 21 | 22 | FILE * symopen(); 23 | 24 | typedef struct { 25 | FILE *fp; 26 | char *md_name; 27 | char *un_name; 28 | char zap; 29 | } Info; 30 | 31 | typedef struct { 32 | word res; 33 | 34 | word bufa; 35 | word ela; 36 | word ina; 37 | word topa; 38 | 39 | word elodd; 40 | word inodd; 41 | word eof; 42 | word flags; 43 | 44 | /* for UNIX */ 45 | 46 | Info *ptr; 47 | } File; 48 | 49 | File *al_file(); 50 | 51 | #ifdef TRACE 52 | fs_show (f) 53 | File *f; 54 | { char buf[BUFSIZE+1]; 55 | int index; 56 | File *file; 57 | 58 | file = al_file ( f ); 59 | trace("fs_show : file = `%s'",file->ptr->un_name); 60 | if ( file->ptr->md_name ) trace("\n"); 61 | else trace(" [ tempfile ]\n"); 62 | if ( file->flags & RD ) trace("READ "); 63 | if ( file->flags & WR ) trace("WRITE "); 64 | if ( file->flags & BYTEMODE ) trace("BYTEMODE "); 65 | if ( file->res ) trace("response <> done "); 66 | trace("\n"); 67 | strncpy ( buf , & stack[file->bufa] , BUFSIZE ); 68 | for ( index = 0 ; index < BUFSIZE ; ++index ) 69 | if ( !isvisible(buf[index]) ) 70 | buf[index] = '?'; 71 | buf[BUFSIZE] = '\0'; 72 | trace("buffer :\n`%s'\n",buf); 73 | if ( file->topa - file->bufa > BUFSIZ/2 ) 74 | { trace("illegal position of file->topa\n"); 75 | crash("s.o"); 76 | } 77 | if ( file->ela < file->topa ) { 78 | for ( index = 0 ; index < file->elodd + (file->ela - file->bufa)*2 ; ++index ) 79 | trace(" "); 80 | trace(" ^ ela\n"); 81 | } 82 | if ( file->ina < file->topa ) { 83 | for ( index = 0 ; index < (file->ina - file->bufa)*2 + file->inodd ; ++index ) 84 | trace(" "); 85 | trace(" ^ ina\n"); 86 | } 87 | for ( index = 0 ; index < (file->topa-file->bufa)*2 ; ++index ) 88 | trace(" "); 89 | trace(" ^ topa\n"); 90 | fr_file(f,file); 91 | } 92 | #endif TRACE 93 | 94 | fs_open ( f , name , len ) 95 | File *f; 96 | char *name; 97 | word len; 98 | { 99 | File *file; 100 | char *fn; 101 | static int index = 0; 102 | char *mode; 103 | 104 | Link(f); 105 | file = al_file(f); 106 | if ( name == 0 ) { /* temporary file */ 107 | CALLOC(fn,11,sizeof(char)); 108 | strcpy(fn,"TMP.XXXXXX"); 109 | fn = mktemp(fn); 110 | mode = "a"; 111 | } 112 | else { 113 | CALLOC(fn,len+1,sizeof(char)); 114 | strncpy(fn,name,len); 115 | fn[len] = '\0'; 116 | mode = "r"; 117 | name = fn; 118 | } 119 | CALLOC(file->ptr,1,sizeof(Info)); 120 | file->ptr->md_name = name; 121 | file->ptr->un_name = fn; 122 | file->ptr->zap = 0; 123 | if ( (file->ptr->fp = fopen(fn,mode)) == NULL ) 124 | { if (mode[0] == 'r' && (file->ptr->fp = symopen(fn))) 125 | file->ptr->zap = 1; 126 | else 127 | { file->res = 1; 128 | fr_file(f,file); 129 | return; 130 | } 131 | } 132 | #ifdef TRACE 133 | trace("fs_open: `%s' has been opened\n",fn); 134 | #endif TRACE 135 | allocate ( 0 , BUFSIZE/2 ); 136 | file->res = 0; 137 | file->bufa = stack[0]; 138 | file->ela = stack[0]; 139 | file->ina = stack[0]; 140 | file->topa = stack[0]+BUFSIZE/2; 141 | file->elodd = 0; 142 | file->inodd = 0; 143 | file->eof = 0; 144 | file->flags = 0; 145 | fr_file(f,file); 146 | } 147 | 148 | /* 149 | * for the modula-2 compiler : 150 | * check for archived symbol file 151 | */ 152 | 153 | FILE * symopen(filename) 154 | char * filename; 155 | { char buf[64]; 156 | extern char * libdir; 157 | 158 | if (strfind(filename, NULL, ".sy", NULL, NULL)) 159 | { sprintf(buf, "ar x SYM %s 2>/dev/null", filename); 160 | if (system(buf)) /* command failed ??? */ 161 | { sprintf(buf, "ar x %sSYM %s 2>/dev/null", 162 | libdir, filename); 163 | if (system(buf)) 164 | return NULL; 165 | } 166 | return fopen(filename, "r"); 167 | } 168 | return NULL; 169 | } 170 | 171 | fs_close ( f ) 172 | File *f; 173 | { 174 | File *file; 175 | 176 | Unlink(f); 177 | file = al_file(f); 178 | fs_doio ( file ); /* geg.falls Buffer leeren */ 179 | if (file->ptr->zap) 180 | unlink(file->ptr->un_name); 181 | dispose ( file->bufa , BUFSIZE/2 ); 182 | fclose(file->ptr->fp); 183 | file->res = 0; 184 | #ifdef TRACE 185 | trace("fs_close(%s)\n",file->ptr->un_name); 186 | #endif TRACE 187 | cfree(file->ptr->un_name); 188 | cfree(file->ptr); 189 | fr_file(f,file); 190 | } 191 | 192 | fs_rename ( f , name , len ) 193 | File *f; 194 | char *name; 195 | word len; 196 | { 197 | File *file; 198 | char buf[14+14+5]; 199 | char *ptr; 200 | 201 | file = al_file(f); 202 | if ( name ) { 203 | if ( len > 14 ) 204 | len = 14; 205 | CALLOC(ptr,len+1,sizeof(char)); 206 | strncpy(ptr,name,len); 207 | ptr[len] = '\0'; 208 | sprintf(buf,"mv %s %s",file->ptr->un_name,ptr); 209 | #ifdef TRACE 210 | trace("fs_rename: %s\n",buf); 211 | #endif TRACE 212 | if ( ptr[0] ) 213 | system(buf); 214 | cfree(file->ptr->un_name); 215 | file->ptr->un_name = ptr; 216 | } 217 | else 218 | file->ptr->md_name = 0; 219 | file->res = 0; 220 | fr_file(f,file); 221 | } 222 | 223 | fs_setread ( f ) 224 | File *f; 225 | { 226 | File *file; 227 | long pos; 228 | 229 | file = al_file(f); 230 | if ( file->flags & WR ) 231 | fs_doio ( file ); 232 | pos = fs_getpos(file); 233 | if ( (file->ptr->fp = freopen(file->ptr->un_name,"r",file->ptr->fp)) 234 | == NULL ) { 235 | file->flags = 0; 236 | file->res = 1; 237 | fr_file(f,file); 238 | return; 239 | } 240 | file->flags |= RD; 241 | file->flags &= ~WR; 242 | file->ina = file->bufa; 243 | #ifdef TRACE 244 | trace("fs_setread: file = %s, file->flags = %o\n",file->ptr->un_name,file->flags); 245 | #endif TRACE 246 | fs_setpos ( file , pos ); 247 | fs_doio ( file ); 248 | fr_file(f,file); 249 | } 250 | 251 | fs_setwrite ( f ) 252 | File *f; 253 | { 254 | File *file; 255 | long pos; 256 | 257 | file = al_file(f); 258 | fs_doio ( file ); 259 | pos = fs_getpos(file); 260 | if ( (file->ptr->fp = freopen(file->ptr->un_name,"a",file->ptr->fp)) 261 | == NULL ) { 262 | file->flags = 0; 263 | file->res = 1; 264 | fr_file(f,file); 265 | return; 266 | } 267 | file->flags |= WR; 268 | file->flags &= ~RD; 269 | file->flags &= ~BYTEMODE; 270 | file->ela = file->bufa; 271 | file->res = 0; 272 | file->eof = 0; 273 | #ifdef TRACE 274 | trace("fs_setwrite: file = %s, file->flags = %o\n",file->ptr->un_name,file->flags); 275 | #endif TRACE 276 | fs_setpos(file,pos); 277 | fr_file(f,file); 278 | } 279 | 280 | fs_setopen ( f ) 281 | File *f; 282 | { 283 | File *file; 284 | 285 | file = al_file(f); 286 | fs_doio(file); 287 | file->flags = 0; 288 | file->res = 0; 289 | #ifdef TRACE 290 | trace("fs_setopen: file = %s\n",file->ptr->un_name); 291 | #endif TRACE 292 | file->eof = 0; 293 | file->ela = file->bufa; 294 | file->ina = file->bufa; 295 | fr_file(f,file); 296 | } 297 | 298 | fs_doio ( f ) 299 | File *f; 300 | { 301 | File *file; 302 | 303 | file = al_file(f); 304 | #ifdef TRACE 305 | if ( file->ela > file->bufa+BUFSIZE/2 ) { 306 | trace("illegal pos of ela\n"); 307 | file->ela = file->bufa; 308 | fs_show(file); 309 | crash("s.o."); 310 | } 311 | #endif TRACE 312 | if ( (file->flags & RD) && file->ela >= file->ina ) { 313 | file->ela = file->bufa; 314 | file->ina = fread( &stack[file->bufa] , sizeof(char) , 315 | BUFSIZE , file->ptr->fp ); 316 | #ifdef TRACE 317 | trace("fs_doio: reads %o characters from file %s\n",file->ina,file->ptr->un_name); 318 | fflush(file->ptr->fp); 319 | #endif TRACE 320 | if ( file->ina == 0 ) { 321 | file->eof = 1; 322 | file->flags = 0; 323 | } 324 | else 325 | file->eof = 0; 326 | file->inodd = file->ina % 2; 327 | file->ina >>= 1; 328 | file->ina += file->bufa; 329 | file->res = 0; 330 | } 331 | else if ( file->flags & WR ) { 332 | if ( (file->ela - file->bufa)*2 + file->elodd > BUFSIZE ) 333 | crash("illegal position of file->ela"); 334 | if ( fwrite( &stack[file->bufa] , sizeof(char) , 335 | (file->ela - file->bufa)*2 + file->elodd , file->ptr->fp ) 336 | != (file->ela - file->bufa)*2 + file->elodd ) 337 | file->res = 1; 338 | else { 339 | #ifdef TRACE 340 | trace("fs_doio: writes %o characters to file %s\n",(file->ela - file->bufa)*2 + file->elodd ,file->ptr->un_name); 341 | fflush(file->ptr->fp); 342 | #endif TRACE 343 | file->ela = file->bufa; 344 | file->res = 0; 345 | } 346 | } 347 | else 348 | file->res = 1; 349 | fr_file(f,file); 350 | } 351 | 352 | fs_setpos ( f , pos ) 353 | File *f; 354 | long pos; 355 | { 356 | File *file; 357 | word odd; 358 | 359 | file = al_file(f); 360 | if ( file->flags & WR ) 361 | fs_doio(file); 362 | odd = pos % 2; 363 | pos >>= 1; pos <<= 1; 364 | if ( fseek(file->ptr->fp,pos, 0 ) ) { 365 | file->res = 1; 366 | file->eof = 1; 367 | } 368 | else { 369 | file->ela = file->ina = file->bufa; 370 | fs_doio ( file ); 371 | file->res = 0; 372 | file->elodd = odd; 373 | } 374 | #ifdef TRACE 375 | trace("fs_setpos: on file %s to position %o\n",file->ptr->un_name,pos+odd); 376 | #endif TRACE 377 | fr_file(f,file); 378 | } 379 | 380 | long 381 | fs_getpos ( f ) 382 | File *f; 383 | { 384 | File *file; 385 | long val; 386 | 387 | file = al_file(f); 388 | file->res = 0; 389 | #ifdef TRACE 390 | trace("fs_getpos: file = %s, pos = %o\n",file->ptr->un_name,ftell(file->ptr->fp) + (file->ela - file->bufa)*2 + file->elodd ); 391 | #endif TRACE 392 | val = ftell(file->ptr->fp) + (file->ela - file->bufa)*2 + file->elodd ; 393 | fr_file(f,file); 394 | return val; 395 | } 396 | 397 | fs_reset ( f ) 398 | File *f; 399 | { 400 | File *file; 401 | 402 | 403 | file = al_file(f); 404 | #ifdef TRACE 405 | trace("fs_reset: file = %s\n",file->ptr->un_name); 406 | #endif TRACE 407 | file->eof = 0; 408 | fs_setpos ( file , 0L ); 409 | fr_file(f,file); 410 | } 411 | 412 | static 413 | File * 414 | al_file ( file ) 415 | File *file; 416 | { 417 | File *ptr; 418 | char *p1,*p2; 419 | int index; 420 | 421 | if (file % 4) 422 | { CALLOC(ptr,1,sizeof(File)); 423 | p1 = (char *) file; 424 | p2 = (char *) ptr; 425 | for ( index = 0 ; index < sizeof(File) ; ++index ) 426 | *p2++ = *p1++; 427 | return(ptr); 428 | } 429 | else 430 | return file; 431 | } 432 | 433 | static 434 | fr_file ( file , adr ) 435 | File *file,*adr; 436 | { 437 | int index; 438 | char *p1,*p2; 439 | 440 | if (file % 4) 441 | { p1 = (char *) file; 442 | p2 = (char *) adr; 443 | for ( index = 0 ; index < sizeof(File) ; ++index ) 444 | *p1++ = *p2++; 445 | cfree(adr); 446 | } 447 | } 448 | 449 | /* 450 | * in case of an error close all files for better debugging 451 | */ 452 | 453 | struct chain { 454 | File *c_file; 455 | struct chain * c_link; 456 | }; 457 | 458 | struct chain * Chain = NULL; 459 | int nounlink = 0; 460 | 461 | Link(f) 462 | File * f; 463 | { struct chain * new; 464 | 465 | if ((new = calloc(sizeof(struct chain), 1)) == NULL) 466 | return; 467 | new->c_file = f; 468 | new->c_link = Chain; 469 | Chain = new; 470 | } 471 | 472 | Unlink(f) 473 | File * f; 474 | { struct chain * old, * ptr; 475 | 476 | if (nounlink) 477 | return; 478 | old = NULL; 479 | for (ptr = Chain; ptr && ptr->c_file != f; ptr = ptr->c_link) 480 | old = ptr; 481 | if (ptr->c_file == f) 482 | { if (old) 483 | old->c_link = ptr->c_link; 484 | else 485 | Chain = ptr->c_link; 486 | cfree(ptr); 487 | } 488 | } 489 | 490 | CloseAll() 491 | { struct chain * ptr; 492 | 493 | ++nounlink; 494 | for (ptr = Chain; ptr; ptr = ptr->c_link) 495 | fs_close(ptr->c_file); 496 | } 497 | -------------------------------------------------------------------------------- /src/l_in.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include "l.h" 3 | 4 | unsigned int sy; 5 | int fs; 6 | 7 | static FILE *in; 8 | static unsigned int nextn; 9 | 10 | initincode ( fp ) 11 | FILE *fp; 12 | { 13 | in = fp; 14 | readword(&nextn); 15 | fs = 0; 16 | } 17 | 18 | readword ( n ) 19 | unsigned int *n; 20 | { 21 | word x; 22 | 23 | if ( ! fread ( &x , sizeof(word) , 1 , in ) ) { 24 | sy = EOFSY; 25 | fs = 0; 26 | *n = 0; 27 | } 28 | else 29 | *n = (unsigned int) x; 30 | } 31 | 32 | getnum ( n ) 33 | unsigned int *n; 34 | { 35 | if ( fs == 0 ) 36 | quit("frame size error"); 37 | else { 38 | --fs; 39 | if ( feof(in) ) { 40 | *n = 0; 41 | if ( fs == 0 ) 42 | quit("frame size error"); 43 | } 44 | else { 45 | *n = nextn; 46 | readword(&nextn); 47 | } 48 | } 49 | } 50 | 51 | skip () 52 | { 53 | unsigned int n; 54 | 55 | while ( fs > 0 ) 56 | getnum ( &n ); 57 | } 58 | 59 | getsy () 60 | { 61 | unsigned int n; 62 | 63 | if ( fs > 0 ) { 64 | quit("frame size error"); 65 | skip(); 66 | } 67 | if ( feof(in) ) 68 | sy = EOFSY; 69 | else { 70 | fs = 1; 71 | getnum ( &n ); 72 | if ( 0200 <= n && n <= 0305 ) { 73 | sy = n; 74 | fs = 1; 75 | getnum ( &fs ); 76 | } 77 | else { 78 | sy = EOFSY; 79 | quit("illegal symbol read: %o",n); 80 | } 81 | } 82 | } 83 | -------------------------------------------------------------------------------- /src/l_init.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Lilith - Interpreter 3 | */ 4 | 5 | #include 6 | #include "l.h" 7 | 8 | extern int stacksize; 9 | extern int codesize; 10 | extern int datasize; 11 | extern int heapsize; 12 | extern word *stack; 13 | extern char *code; 14 | extern int boot; 15 | extern int S; 16 | 17 | init () 18 | { 19 | stacksize *= 512; 20 | codesize *= 1024; 21 | datasize *= 512; 22 | heapsize *= 512; 23 | 24 | boot = TRUE; 25 | CALLOC(stack,sizeof(word),stacksize+datasize+heapsize); 26 | CALLOC(code,sizeof(char),codesize); 27 | S = datasize; 28 | dispose(stacksize+datasize,heapsize); 29 | } 30 | -------------------------------------------------------------------------------- /src/l_load.c: -------------------------------------------------------------------------------- 1 | #ifdef LT 2 | # define TRACE 3 | #endif LT 4 | /* 5 | * Lilith 6 | */ 7 | 8 | #include 9 | #include "l.h" 10 | 11 | extern word *stack; 12 | extern int stacksize; 13 | extern char *code; 14 | extern int codesize; 15 | extern int datasize; 16 | extern int S; 17 | 18 | int tocall; /* als Information fuer den SVC 40 */ 19 | 20 | int baseptr; /* -> auf globale Datenflaeche nach der Base */ 21 | int topptr; /* -> auf das aktuelle Ende der globalen Fl. */ 22 | int codeptr; /* -> auf das aktuelle Ende der Codeflaeche */ 23 | int cbptr; /* -> auf das Ende des Codes nach der Base */ 24 | 25 | extern unsigned int sy; 26 | extern int fs; 27 | 28 | int boot; 29 | 30 | char *libdir = "/usr/spez/diplom/borchert/lib/"; 31 | 32 | load ( filename ) 33 | char *filename; 34 | { 35 | FILE *fp; 36 | unsigned int n; 37 | int main_mod; 38 | int main_over = FALSE; 39 | 40 | if ( (fp = fopen(filename,"r")) == NULL ) { 41 | char *ptr; 42 | 43 | if ( (ptr = malloc(strlen(libdir)+strlen(filename)+1)) == NULL ) 44 | pquit("malloc"); 45 | strcpy(ptr, libdir); 46 | strcat(ptr, filename); 47 | if ( (fp = fopen(ptr,"r")) == NULL ) 48 | pquit(filename); 49 | free(ptr); 50 | } 51 | initincode(fp); 52 | getsy(); 53 | main_mod = boot; 54 | if ( boot ) { 55 | topptr = 0200; 56 | codeptr = 0; 57 | if ( sy != xBASE ) 58 | quit("%s: Bad format",filename); 59 | skip(); 60 | getsy(); 61 | stack[4] = S; 62 | stack[S] = topptr; 63 | stack[S+1] = 0; /* dynamic link */ 64 | /* stack[S+2] = PC */ 65 | stack[S+3] = 0; /* M */ 66 | stack[S+4] = S+7; 67 | stack[S+5] = 0; /* H + 24 */ 68 | stack[S+6] = 0; 69 | stack[S+7] = 0; 70 | stack[DFT] = -1; /* module 0 darf nicht aufgerufen werden */ 71 | } 72 | else { 73 | codeptr = cbptr; 74 | topptr = baseptr; 75 | main_over = TRUE; 76 | } 77 | while ( sy == xMODULE ) { 78 | if ( codeptr % 4 != 0 ) { /* 4-er Kante ? */ 79 | codeptr &= 0xFFFFFFFC; 80 | codeptr += 4; 81 | } 82 | getnum ( &n ); /* ModuleNumber */ 83 | if ( main_over ) { 84 | main_over = FALSE; 85 | tocall = n; /* fuer SVC 40 */ 86 | } 87 | #ifdef TRACE 88 | trace("load: module %o: code at %o, data at %o\n",n,codeptr,topptr); 89 | #endif TRACE 90 | if ( n > 0200 - DFT ) 91 | quit("illegal module number : %o",n); 92 | stack[DFT+n] = topptr; 93 | stack[topptr++] = codeptr/4; 94 | getsy(); /* xDATATEXT */ 95 | getnum ( &n ); /* 0 */ 96 | while ( fs ) { 97 | getnum ( &n ); 98 | if ( topptr >= datasize-1 ) 99 | quit("data segment overflow"); 100 | stack[topptr++] = (word) n; 101 | } 102 | if ( main_mod ) { 103 | main_mod = FALSE; 104 | stack[S+2] = codeptr; /* Startaddresse */ 105 | } 106 | getsy(); /* xCODETEXT */ 107 | while ( fs ) { 108 | getnum ( &n ); 109 | if ( codeptr >= codesize-2 ) 110 | quit("code segment overflow"); 111 | code[codeptr++] = n / 0x100; 112 | code[codeptr++] = n % 0x100; 113 | } 114 | getsy(); 115 | } 116 | if ( boot ) { 117 | boot = FALSE; 118 | cbptr = codeptr; 119 | baseptr = topptr; 120 | } 121 | fclose(fp); 122 | } 123 | -------------------------------------------------------------------------------- /src/l_main.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Lilith - Interpreter 3 | */ 4 | 5 | #include 6 | #include 7 | 8 | extern int stacksize; 9 | extern int codesize; 10 | extern int datasize; 11 | extern int heapsize; 12 | 13 | extern int crash(); 14 | 15 | int no_checks = 0; 16 | char usage[] = { "Usage: %s [-d datasize] [-s stacksize] [-c codesize] [-h heap] [-n] base" }; 17 | 18 | main ( argc , argv ) 19 | int argc; 20 | char **argv; 21 | { 22 | char *lilith_name; 23 | 24 | if ( lilith_name = rindex(*argv,'/') ) 25 | ++lilith_name; 26 | else 27 | lilith_name = *argv; 28 | stacksize = 4; /* K */ 29 | codesize = 20; /* K */ 30 | datasize = 10; /* K */ 31 | heapsize = 10; /* K */ 32 | 33 | while ( --argc && **++argv == '-' ) switch ( argv[0][1] ) { 34 | case 'c' : 35 | if ( --argc ) 36 | sscanf ( *++argv , "%d" , & codesize ); 37 | else 38 | quit(usage,lilith_name); 39 | break; 40 | case 'd' : 41 | if ( --argc ) 42 | sscanf ( *++argv , "%d" , & datasize ); 43 | else 44 | quit(usage,lilith_name); 45 | break; 46 | case 'h' : 47 | if ( --argc ) 48 | sscanf ( *++argv , "%d" , & heapsize ); 49 | else 50 | quit(usage,lilith_name); 51 | break; 52 | case 's' : 53 | if ( --argc ) 54 | sscanf ( *++argv , "%d" , &stacksize ); 55 | else 56 | quit(usage,lilith_name); 57 | break; 58 | case 'n' : /* no checks */ 59 | ++no_checks; 60 | break; 61 | default : 62 | quit(usage,lilith_name); 63 | } 64 | if ( argc != 1 ) 65 | quit(usage,lilith_name); 66 | init (); 67 | load ( *argv ); 68 | if (! signal(SIGQUIT, SIG_IGN)) 69 | signal(SIGQUIT, crash); 70 | execute (); 71 | } 72 | -------------------------------------------------------------------------------- /src/l_mnem.c: -------------------------------------------------------------------------------- 1 | #ifdef LT 2 | # define TRACE 3 | #endif 4 | 5 | #ifdef TRACE 6 | char *mnem[] = { 7 | "LI0", 8 | "LI1", 9 | "LI2", 10 | "LI3", 11 | "LI4", 12 | "LI5", 13 | "LI6", 14 | "LI7", 15 | "LI8", 16 | "LI9", 17 | "LI10", 18 | "LI11", 19 | "LI12", 20 | "LI13", 21 | "LI14", 22 | "LI15", 23 | "LIB", 24 | "ILL.", 25 | "LIW", 26 | "LID", 27 | "LLA", 28 | "LGA", 29 | "LSA", 30 | "LEA", 31 | "JPC", 32 | "JP", 33 | "JPFC", 34 | "JPF", 35 | "JPBC", 36 | "JPB", 37 | "ORJP", 38 | "ANDJP", 39 | "LLW", 40 | "LLD", 41 | "LEW", 42 | "LED", 43 | "LLW4", 44 | "LLW5", 45 | "LLW6", 46 | "LLW7", 47 | "LLW8", 48 | "LLW9", 49 | "LLW10", 50 | "LLW11", 51 | "LLW12", 52 | "LLW13", 53 | "LLW14", 54 | "LLW15", 55 | "SLW", 56 | "SLD", 57 | "SEW", 58 | "SED", 59 | "SLW4", 60 | "SLW5", 61 | "SLW6", 62 | "SLW7", 63 | "SLW8", 64 | "SLW9", 65 | "SLW10", 66 | "SLW11", 67 | "SLW12", 68 | "SLW13", 69 | "SLW14", 70 | "SLW15", 71 | "LGW", 72 | "LGD", 73 | "LGW2", 74 | "LGW3", 75 | "LGW4", 76 | "LGW5", 77 | "LGW6", 78 | "LGW7", 79 | "LGW8", 80 | "LGW9", 81 | "LGW10", 82 | "LGW11", 83 | "LGW12", 84 | "LGW13", 85 | "LGW14", 86 | "LGW15", 87 | "SGW", 88 | "SGD", 89 | "SGW2", 90 | "SGW3", 91 | "SGW4", 92 | "SGW5", 93 | "SGW6", 94 | "SGW7", 95 | "SGW8", 96 | "SGW9", 97 | "SGW10", 98 | "SGW11", 99 | "SGW12", 100 | "SGW13", 101 | "SGW14", 102 | "SGW15", 103 | "LSW0", 104 | "LSW1", 105 | "LSW2", 106 | "LSW3", 107 | "LSW4", 108 | "LSW5", 109 | "LSW6", 110 | "LSW7", 111 | "LSW8", 112 | "LSW9", 113 | "LSW10", 114 | "LSW11", 115 | "LSW12", 116 | "LSW13", 117 | "LSW14", 118 | "LSW15", 119 | "SSW0", 120 | "SSW1", 121 | "SSW2", 122 | "SSW3", 123 | "SSW4", 124 | "SSW5", 125 | "SSW6", 126 | "SSW7", 127 | "SSW8", 128 | "SSW9", 129 | "SSW10", 130 | "SSW11", 131 | "SSW12", 132 | "SSW13", 133 | "SSW14", 134 | "SSW15", 135 | "LSW", 136 | "LSD", 137 | "LSDO", 138 | "LXFW", 139 | "LSTA", 140 | "LXB", 141 | "LXW", 142 | "LXD", 143 | "DADD", 144 | "DSUB", 145 | "DMUL", 146 | "DDIV", 147 | "ILL.", 148 | "ILL.", 149 | "DSHL", 150 | "DSHR", 151 | "SSW", 152 | "SSD", 153 | "SSDO", 154 | "SXFW", 155 | "TS", 156 | "SXB", 157 | "SXW", 158 | "SXD", 159 | "FADD", 160 | "FSUB", 161 | "FMUL", 162 | "FDIV", 163 | "FCMP", 164 | "FABS", 165 | "FNEG", 166 | "FFCT", 167 | "READ", 168 | "WRITE", 169 | "DSKR", 170 | "DSKW", 171 | "SETRK", 172 | "UCHK", 173 | "SVC", 174 | "SYS", 175 | "ENTP", 176 | "EXP", 177 | "ULSS", 178 | "ULEQ", 179 | "UGTR", 180 | "UGEQ", 181 | "TRA", 182 | "RDS", 183 | "LODFW", 184 | "LODFD", 185 | "STORE", 186 | "STOFV", 187 | "STOT", 188 | "COPT", 189 | "DECS", 190 | "PCOP", 191 | "UADD", 192 | "USUB", 193 | "UMUL", 194 | "UDIV", 195 | "UMOD", 196 | "ROR", 197 | "SHL", 198 | "SHR", 199 | "FOR1", 200 | "FOR2", 201 | "ENTC", 202 | "EXC", 203 | "TRAP", 204 | "CHK", 205 | "CHKZ", 206 | "CHKS", 207 | "EQL", 208 | "NEQ", 209 | "LSS", 210 | "LEQ", 211 | "GTR", 212 | "GEQ", 213 | "ABS", 214 | "NEG", 215 | "OR", 216 | "XOR", 217 | "AND", 218 | "COM", 219 | "IN", 220 | "LIN", 221 | "MSK", 222 | "NOT", 223 | "ADD", 224 | "SUB", 225 | "MUL", 226 | "DIV", 227 | "MOD", 228 | "BIT", 229 | "NOP", 230 | "MOVF", 231 | "MOV", 232 | "CMP", 233 | "DDT", 234 | "REPL", 235 | "BBLT", 236 | "DCH", 237 | "UNPK", 238 | "PACK", 239 | "GB", 240 | "GB1", 241 | "ALOC", 242 | "ENTR", 243 | "RTN", 244 | "CX", 245 | "CI", 246 | "CF", 247 | "CL", 248 | "CL1", 249 | "CL2", 250 | "CL3", 251 | "CL4", 252 | "CL5", 253 | "CL6", 254 | "CL7", 255 | "CL8", 256 | "CL9", 257 | "CL10", 258 | "CL11", 259 | "CL12", 260 | "CL13", 261 | "CL14", 262 | "CL15" 263 | }; 264 | #endif 265 | -------------------------------------------------------------------------------- /src/l_quit.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | extern int errno; 4 | extern int sys_nerr; 5 | extern char *sys_errlist[]; 6 | 7 | quit ( s , p1 , p2 , p3 , p4 , p5 , p6 ) 8 | { 9 | fprintf(stderr,s,p1,p2,p3,p4,p5,p6); 10 | fprintf(stderr," - QUIT\n"); 11 | #ifdef TRACE 12 | eox(); 13 | #endif TRACE 14 | exit(1); 15 | } 16 | 17 | pquit ( s ) 18 | char *s; 19 | { 20 | if ( errno < sys_nerr ) 21 | quit("%s: %s",s,sys_errlist[errno]); 22 | else 23 | quit("%s: unknown error (code = %d)",s,errno); 24 | } 25 | -------------------------------------------------------------------------------- /src/l_stor.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Storage Module for Lilith 3 | */ 4 | 5 | #include "l.h" 6 | 7 | extern word *stack; 8 | int heapsize; 9 | 10 | typedef struct free { 11 | word next; 12 | word size; 13 | } freenode; 14 | 15 | freenode first = { 0 , 0 }; 16 | 17 | dispose ( index , size ) 18 | word index; /* -> auf freie Flaeche */ 19 | word size; /* in Worten */ 20 | { 21 | freenode *ptr; 22 | 23 | if ( size % 2 ) 24 | --size; 25 | if ( size >= sizeof(freenode)/sizeof(word) ) { 26 | ptr = (freenode *) &stack[index]; 27 | ptr->next = first.next; 28 | ptr->size = size; 29 | first.next = index; 30 | } 31 | } 32 | 33 | allocate ( index , size ) 34 | word index; /* hier wird die Adr. der angelegten Flaeche abgel. */ 35 | word size; /* in Worten */ 36 | { 37 | word ptr; 38 | freenode *pre; 39 | 40 | if ( size % 2 ) 41 | ++size; 42 | pre = &first; 43 | for ( ptr = first.next ; ptr && stack[ptr+1] < size ; ptr = stack[ptr] ) 44 | pre = (freenode *) &stack[ptr]; 45 | if ( ptr ) { 46 | if ( stack[ptr+1] - size >= sizeof(freenode)/sizeof(word) ) { 47 | stack[ptr+1] -= size; 48 | stack[index] = ptr + stack[ptr+1]; 49 | } 50 | else { 51 | pre->next = stack[ptr]; 52 | stack[index] = ptr; 53 | } 54 | } 55 | else 56 | quit("heap segment overflow"); 57 | #ifdef TRACE 58 | trace("ALLOCATE: stack[index] = %o\n",stack[index]); 59 | #endif TRACE 60 | } 61 | -------------------------------------------------------------------------------- /src/l_storage.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Storage Module for Lilith 3 | */ 4 | 5 | #include "l.h" 6 | 7 | extern word *stack; 8 | extern int datasize; 9 | extern int stacksize; 10 | int heapsize; 11 | static int heapindex = 0; 12 | 13 | dispose ( index , size ) 14 | word index; 15 | word size; /* in Worten */ 16 | { 17 | } 18 | 19 | allocate ( index , size ) 20 | word index; 21 | word size; /* in Worten */ 22 | { 23 | 24 | if ( heapindex + size < heapsize ) { 25 | if ( size >= 2 && heapindex % 2 ) { 26 | heapindex &= 0xFFFFFFFE; 27 | heapindex += 2; 28 | } 29 | stack[index] = heapindex+datasize+stacksize; 30 | heapindex += size; 31 | } 32 | else 33 | quit("heap segment overflow"); 34 | #ifdef TRACE 35 | trace("ALLOCATE: stack[index] = %o\n",stack[index]); 36 | #endif TRACE 37 | } 38 | -------------------------------------------------------------------------------- /src/l_svc.c: -------------------------------------------------------------------------------- 1 | #ifdef LT 2 | #define TRACE 3 | #endif LT 4 | /* 5 | * Super Visor Calls 6 | */ 7 | 8 | #include 9 | #include 10 | #include "l.h" 11 | 12 | extern word *stack; 13 | extern word L; 14 | extern word G; 15 | extern word PC; 16 | extern word F; 17 | extern word pop(); 18 | extern int tocall; 19 | 20 | svc ( n ) 21 | word n; 22 | { 23 | static int readagain = FALSE; 24 | static int ch; 25 | char filename[15]; 26 | word stat; 27 | register word len; 28 | char *ptr; 29 | register word index; 30 | register word index2; 31 | word new; 32 | word lowpos,highpos; 33 | long pos; 34 | 35 | switch ( n ) { 36 | case 1 : /* PROCEDURE Create(VAR f:File; 37 | mediumname: ARRAY OF CHAR); */ 38 | len = pop() + 1; 39 | index2 = pop(); 40 | index = pop(); 41 | #ifdef TRACE 42 | trace("Create(%o,\"%s\")\n",index,&stack[index2]); 43 | #endif TRACE 44 | fs_open ( &stack[index] , NULL ); 45 | break; 46 | case 2 : /* PROCEDURE Close(VAR f:File); */ 47 | index = pop(); 48 | #ifdef TRACE 49 | trace("Close(%o)\n",index); 50 | #endif TRACE 51 | fs_close ( &stack[index] ); 52 | break; 53 | case 3 : /* PROCEDURE Lookup(VAR f:File; 54 | filename:ARRAY OF CHAR; 55 | new: BOOLEAN); */ 56 | new = pop(); 57 | len = pop() + 1; 58 | index2 = pop(); 59 | index = pop(); 60 | #ifdef TRACE 61 | trace("Lookup(%o,\"%s\",%o)\n",index,&stack[index2],new); 62 | #endif TRACE 63 | fs_open ( &stack[index] , &stack[index2] , len ); 64 | break; 65 | case 4 : /* PROCEDURE Rename(VAR f:File; 66 | filename:ARRAY OF CHAR); */ 67 | len = pop() + 1; 68 | index2 = pop(); 69 | index = pop(); 70 | #ifdef TRACE 71 | trace("Rename(%o,\"%s\")\n",index,&stack[index2]); 72 | #endif 73 | fs_rename ( &stack[index] , &stack[index2] , len); 74 | break; 75 | case 5 : /* PROCEDURE SetRead(VAR f:File); */ 76 | index = pop(); 77 | #ifdef TRACE 78 | trace("SetRead(%o)\n",index); 79 | #endif 80 | fs_setread ( &stack[index] ); 81 | break; 82 | case 6 : /* PROCEDURE SetWrite(VAR f:File); */ 83 | index = pop(); 84 | #ifdef TRACE 85 | trace("SetWrite(%o)\n",index); 86 | #endif 87 | fs_setwrite ( &stack[index] ); 88 | break; 89 | case 8 : /* PROCEDURE SetOpen(VAR f:File); */ 90 | index = pop(); 91 | #ifdef TRACE 92 | trace("SetOpen(%o)\n",index); 93 | #endif 94 | fs_setopen ( &stack[index] ); 95 | break; 96 | case 9 : /* PROCEDURE Doio(VAR f:File); */ 97 | index = pop(); 98 | #ifdef TRACE 99 | trace("Doio(%o)\n",index); 100 | #endif 101 | fs_doio ( &stack[index] ); 102 | break; 103 | case 10 : /* PROCEDURE SetPos(VAR f:File; 104 | highpos, lowpos: CARDINAL); */ 105 | lowpos = pop(); 106 | highpos = pop(); 107 | index = pop(); 108 | #ifdef TRACE 109 | trace("SetPos(%o,%o)\n",index,highpos*0x10000+lowpos); 110 | #endif TRACE 111 | fs_setpos ( &stack[index] , highpos*0x10000+lowpos); 112 | break; 113 | case 11 : /* PROCEDURE GetPos(VAR f:File; 114 | VAR highpos, lowpos: CARDINAL); */ 115 | lowpos = pop(); 116 | highpos = pop(); 117 | index = pop(); 118 | pos = fs_getpos ( &stack[index] ); 119 | stack[highpos] = (word) pos / 0x10000; 120 | stack[lowpos] = (word) pos % 0x10000; 121 | break; 122 | case 13 : /* PROCEDURE Reset(VAR f:File); */ 123 | index = pop(); 124 | fs_reset ( &stack[index] ); 125 | break; 126 | case 30 : /* PROCEDURE GetTime (VAR time: Time); */ 127 | index = pop(); 128 | stack[index] = 0; 129 | stack[index+1] = 0; 130 | stack[index+2] = 0; 131 | break; 132 | case 40 : /* PROCEDURE Call (filename: ARRAY OF CHAR; 133 | flag: BOOLEAN; 134 | VAR stat: Status); */ 135 | stat = pop(); 136 | stack[stat] = 0; /* normal */ 137 | pop(); /* flag wird ignoriert */ 138 | len = pop() + 1; 139 | if ( len > 14 ) 140 | len = 14; 141 | index = pop(); 142 | ptr = (char *) &stack[index]; 143 | strncpy ( filename , ptr , len ); 144 | filename[len] = '\0'; 145 | #ifdef TRACE 146 | trace("\nCall(%s)\n",filename); 147 | #endif 148 | assert( filename[0] ); 149 | load(filename); 150 | 151 | /* 152 | * jetzt ein "CX tocall 0" simulieren 153 | */ 154 | mark(G,TRUE); 155 | G = stack[DFT+tocall]; 156 | F = stack[G]; 157 | PC = 0; 158 | PC = next2(); 159 | break; 160 | case 50 : /* PROCEDURE ALLOCATE(VAR a: ADDRESS; n: CARDINAL); */ 161 | len = pop(); 162 | index = pop(); 163 | #ifdef TRACE 164 | trace("ALLOCATE(%o,%o)\n",index,len); 165 | #endif TRACE 166 | allocate ( index , len ); 167 | break; 168 | case 51 : /* PROCEDURE DEALLOCATE(VAR a: ADDRESS; 169 | n: CARDINAL); */ 170 | len = pop(); 171 | index = pop(); 172 | #ifdef TRACE 173 | trace("DEALLOCATE(%o,%o)\n",index,len); 174 | #endif TRACE 175 | dispose ( stack[index] , len ); 176 | stack[index] = 0xFFFF; /* NIL - Pointer */ 177 | break; 178 | case 60 : /* PROCEDURE Read(VAR ch: CHAR); */ 179 | index = pop(); 180 | if ( readagain ) 181 | readagain = FALSE; 182 | else 183 | ch = getchar(); 184 | #ifdef TRACE 185 | trace("Read: liefert `%c' (%o) bei stack[%o] zurueck\n",ch,ch,index); 186 | #endif TRACE 187 | stack[index] = (word) ch; 188 | break; 189 | case 62 : /* PROCEDURE ReadAgain; */ 190 | readagain = TRUE; 191 | #ifdef TRACE 192 | trace("ReadAgain called\n"); 193 | #endif TRACE 194 | break; 195 | case 63 : /* PROCEDURE Write(ch: CHAR); */ 196 | index = pop(); 197 | putchar(index); 198 | #ifdef TRACE 199 | trace("Write ( '%c' )\n",index); 200 | #endif TRACE 201 | break; 202 | case 64 : /* PROCEDURE WriteLn; */ 203 | putchar('\n'); 204 | #ifdef TRACE 205 | trace("WriteLn\n"); 206 | #endif TRACE 207 | break; 208 | case 65 : /* PROCEDURE WriteString(s: ARRAY OF CHAR); */ 209 | len = pop() + 1; 210 | index = pop(); 211 | ptr = (char *) &stack[index]; 212 | #ifdef TRACE 213 | trace("WriteString(\""); 214 | #endif TRACE 215 | while ( len && *ptr ) { 216 | #ifdef TRACE 217 | trace("%c",*ptr); 218 | #endif TRACE 219 | putchar(*ptr++); 220 | --len; 221 | } 222 | #ifdef TRACE 223 | trace("\")\n"); 224 | #endif TRACE 225 | break; 226 | default : 227 | quit("\nSVC %o not implemented !",n); 228 | } 229 | } 230 | -------------------------------------------------------------------------------- /src/l_trace.c: -------------------------------------------------------------------------------- 1 | #ifdef LT 2 | # define TRACE 3 | #endif LT 4 | 5 | #ifdef TRACE 6 | #include 7 | 8 | trace(s,p1,p2,p3,p4,p5,p6) 9 | { 10 | fprintf(stderr,s,p1,p2,p3,p4,p5,p6); 11 | } 12 | 13 | #endif TRACE 14 | --------------------------------------------------------------------------------