├── .gitignore ├── LICENSE ├── README.md ├── a ├── Makefile ├── args.h ├── b.c ├── b.h ├── development.h ├── dict ├── f.c ├── f.h ├── fir.h ├── h ├── i.c ├── j.c ├── k.c ├── k.h ├── m.c ├── main.c ├── n.c ├── nsf.c ├── o.c ├── p.c ├── q.c ├── r.c ├── s.c ├── s.h ├── u.c ├── u.h ├── x.h ├── y.c └── z.c └── dap ├── Warn.h ├── args.h ├── args_data.c ├── argsfirst.c ├── argsgetopt.c ├── argsnext.c ├── avl.h ├── balloc.c ├── balloc.h ├── bfree.c ├── brealloc.c ├── buff.h ├── buffalloc.c ├── buffputlong.c ├── buffroom.c ├── buffstuff.c ├── chan.h ├── conn.h ├── dap.h ├── error.c ├── exbo.h ├── fds.h ├── fletch.h ├── hash.h ├── hpp.h ├── kvp.h ├── lstn.h ├── misc.h ├── mtm.h ├── node.h ├── notsunos4.h ├── sgnl.h ├── slpq.h ├── timer.h ├── tr.h ├── tv.h ├── ulto.h ├── ultodec.c └── ultohex.c /.gitignore: -------------------------------------------------------------------------------- 1 | *.*~ 2 | *~ 3 | *.o 4 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 2, June 1991 3 | 4 | Copyright (C) 1989, 1991 Free Software Foundation, Inc. 5 | 59 Temple Place - Suite 330, Boston, MA 02111-1307, 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 Library 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 | Appendix: 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) 19yy 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 307 | along with this program; if not, write to the Free Software 308 | Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 309 | USA. 310 | 311 | Also add information on how to contact you by electronic and paper mail. 312 | 313 | If the program is interactive, make it output a short notice like this 314 | when it starts in an interactive mode: 315 | 316 | Gnomovision version 69, Copyright (C) 19yy name of author 317 | Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 318 | This is free software, and you are welcome to redistribute it 319 | under certain conditions; type `show c' for details. 320 | 321 | The hypothetical commands `show w' and `show c' should show the appropriate 322 | parts of the General Public License. Of course, the commands you use may 323 | be called something other than `show w' and `show c'; they could even be 324 | mouse-clicks or menu items--whatever suits your program. 325 | 326 | You should also get your employer (if you work as a programmer) or your 327 | school, if any, to sign a "copyright disclaimer" for the program, if 328 | necessary. Here is a sample; alter the names: 329 | 330 | Yoyodyne, Inc., hereby disclaims all copyright interest in the program 331 | `Gnomovision' (which makes passes at compilers) written by James Hacker. 332 | 333 | , 1 April 1989 334 | Ty Coon, President of Vice 335 | 336 | This General Public License does not permit incorporating your program into 337 | proprietary programs. If your program is a subroutine library, you may 338 | consider it more useful to permit linking proprietary applications with the 339 | library. If this is what you want to do, use the GNU Library General 340 | Public License instead of this License. 341 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | The focus of this repository is the version of the interpreter 2 | portion of the A+ system distributed by Morgan Stanley that 3 | existed when Arthur Whitney left MS (to cofound Kx Systems). 4 | In particular, it shows the buddy space management system that 5 | was eliminated in later versions, and shows more of Arthur's 6 | unique coding style. 7 | 8 | Note that this version is 32-bit, and dates from 4/30/1993. 9 | An open source 64-bit version was not released til 3/27/2008. 10 | 11 | Why is this relevant? 12 | 13 | 1) "Notation as a tool of thought" (Ken Iverson). 14 | Arthur Whitney is a talented implementor of computer languages, eg., 15 | a version of Scheme, a port of IPSA APL to limited hardware, A+, 16 | k, KSQL, q, KDB+, and shakti. The notation he uses is significant. 17 | 18 | 2) The study of Domain Specific Languages: Ostensibly Arthur uses C. 19 | Actually, he uses the C preprocessor to create a terse language of his 20 | own. The style is referred to as the "ATW_VERSION" in the file a/b.c. 21 | 22 | 3) A study of ATW-C directly carries over to k, q/KDB+, or shakti. 23 | The style of using very short functions is helpful. Supposedly, 24 | Arthur never bothered to learn GDB (or other debugging tools 25 | normally used with C). You would not use such tools with q/KDB+ 26 | either. Comments are sparse (or nonexistent). 27 | 28 | 4) Code as Poetry. Read, study, and enjoy. 29 | An extreme example of contrasting styles is contained in file a/b.c. 30 | There are 2 versions of the buddy memory allocation system. The 31 | "ATW_VERSION" has 11 lines. The second is in well documented 32 | traditional C (almost 750 lines). 33 | 34 | Why does the code compile on a 32-bit Linux, but not work? (See issues) 35 | 36 | Again, it may have to do with file a/b.c. The traditional C version in 37 | a/b.c has a comment stating that "these procedures depend critically on 38 | the memory configuration of the computer performing these procedures". 39 | The code in a/b.c is tuned for Solaris on Sun workstattions. It undoubtedly 40 | needs modification to work with Linux or Windows or macOS on Intel processors. 41 | Another strong possibility is that there are typos that remain (see partial 42 | fix to issue 3). This entire repository was keyed in from source documents. 43 | 44 | ------------------------------------------------------------------------- 45 | 46 | A+ and the A+ Reference Manual are Copyright Morgan Stanley Dean Witter & 47 | Co. They are distributed under the GNU General Public License and the GNU 48 | Free Documentation License and available from http://www.aplusdev.org/. 49 | See the file LICENSE and the appendix titled GNU Free Documentation 50 | License of the reference manual regarding the terms under which A+ 51 | software and documentation is being made available. 52 | 53 | -------------------------------------------------------------------------------- /a/Makefile: -------------------------------------------------------------------------------- 1 | PREFIX= /usr/local 2 | CFLAGS= -g -m32 -DATW_VERSION -I../ 3 | PRODFLAGS = -O3 #-pg -g3 4 | LIB=libbud.a 5 | DEVFLAGS = -O0 -g3 -DDEBUG -Wunused -Wreturn-type -Wimplicit-int #-Wall 6 | 7 | OS := $(shell uname -s | tr "[:upper:]" "[:lower:]") 8 | 9 | 10 | CFLAGS += -pthread 11 | 12 | OBJS= main.o m.o y.o u.o p.o r.o k.o f.o s.o o.o n.o i.o q.o j.o b.o nsf.o z.o \ 13 | ../dap/argsfirst.o ../dap/argsgetopt.o ../dap/error.o ../dap/args_data.o \ 14 | ../dap/brealloc.o ../dap/bfree.o ../dap/balloc.o ../dap/buffalloc.o \ 15 | ../dap/argsnext.o ../dap/buffputlong.o ../dap/buffstuff.o ../dap/buffroom.o \ 16 | ../dap/ultohex.o ../dap/ultodec.o 17 | 18 | LDFLAGS = -lm -ldl 19 | 20 | all: bud 21 | 22 | lib: $(LIB) 23 | 24 | $(LIB): $(OBJS) 25 | $(AR) crv $@ $(OBJS) 26 | 27 | bud: CFLAGS += $(PRODFLAGS) 28 | bud: $(OBJS) 29 | $(CC) ${CFLAGS} $^ -o $@ $(LDFLAGS) 30 | 31 | install: 32 | install bud $(PREFIX)/bin/bud 33 | 34 | clean: 35 | $(RM) -r bud *.exe a/*.o 36 | 37 | TAGS: *.c *.h 38 | etags *.[ch] 39 | 40 | %.t.o: %.c 41 | $(CC) $(CFLAGS) -c $(CPPFLAGS) -o $@ $< 42 | 43 | .PHONY: all clean install 44 | 45 | # Dependencies. 46 | ${OBJS}: u.h 47 | ${OBJS}: k.h 48 | main.o nsf.o y.o j.o m.o n.o k.o i.o f.o s.o o.o u.o p.o: f.h 49 | u.o p.o: s.h 50 | nsf.o: fir.h 51 | nsf.o n.o: x.h 52 | main.o: args.h 53 | 54 | 55 | # DO NOT DELETE 56 | -------------------------------------------------------------------------------- /a/args.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_args_h 2 | #define included_dap_args_h 3 | 4 | /* args functions assume that argc and argv will not be altered 5 | * while processing the arguments, thus the check for empty list 6 | * or null arguments only occurs at the start of processing of a 7 | * given list or argument. 8 | */ 9 | 10 | 11 | /* external data declarations */ 12 | extern int args_argpos; 13 | extern int args_index; 14 | extern char *args_value; 15 | 16 | /* external function declarations */ 17 | #if defined(__STDC__) || defined(__cplusplus) || defined(_AIX) 18 | # ifdef __cplusplus 19 | extern "C" { 20 | # endif 21 | extern int argsfirst(int, char**); 22 | extern int argsgetopt(int, char**,char *); 23 | extern void argsnext(int, char**); 24 | # ifdef __cplusplus 25 | } 26 | # endif 27 | #else 28 | extern int argsfirst(); 29 | extern int argsgetopt(); 30 | extern void argsnext(); 31 | #endif 32 | 33 | #endif 34 | 35 | -------------------------------------------------------------------------------- /a/b.h: -------------------------------------------------------------------------------- 1 | #ifndef included_a_b_h 2 | #define incleded_a_b_h 3 | 4 | /* Copyright (c) 1990, Morgan Stanley Group, Inc */ 5 | 6 | /* @(#) $Id: b.h, v 1.7 1992/08/31 05:31:19 dff Exp $ */ 7 | 8 | /* header file inclusions */ 9 | #include 10 | 11 | /* external macro declarations */ 12 | #define MD 31 13 | 14 | /* external data declarations */ 15 | /* number of words in block of given scale */ 16 | extern u_long MZ[]; 17 | 18 | /* external function declarations */ 19 | /* allocate block of memory to hold the given number of words */ 20 | extern long *ma(); /* return pointer to allocated memory */ 21 | 22 | /* allocate block of memeory to hold the given number of bytes */ 23 | extern char *mab(); /* return the pointer to allocated memory */ 24 | 25 | /* free a previously allocated block of memory */ 26 | extern void mf(); /* does not return anything */ 27 | 28 | /* initialize the memory allocator */ 29 | extern void mi(); /* does not return anything */ 30 | 31 | /* coalesce free fragments into larger free fragments */ 32 | extern u_long mc(); /* returns scale of largest free block */ 33 | 34 | /* bring additional memory under managment */ 35 | extern u_long mb(); /* returns scale of largest block */ 36 | 37 | /* recompute the count of free blocks at each scale */ 38 | extern u_long *mz(); /* return a pointer to the counts */ 39 | 40 | /* function for adding more temporary workspace */ 41 | extern tmp(); 42 | 43 | /* A's error function */ 44 | extern err(); 45 | 46 | #endif 47 | -------------------------------------------------------------------------------- /a/development.h: -------------------------------------------------------------------------------- 1 | #ifndef included_a_development_h 2 | #define included_a_development_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1990-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | #if defined(HAVE_SVR4) 13 | # if defined(__sgi) || defined(SOLARIS_CSET) 14 | # define DEV_STRARG char * 15 | # else 16 | # if defined(__GNUC__) || defined(__SUNPRO_CC) || defined(__SUNPRO_C) || defined(__osf__) 17 | # define DEV_STRARG const char * 18 | # else 19 | # define DEV_STRARG unsigned char * 20 | # endif 21 | # endif 22 | 23 | # ifdef __cplusplus 24 | # ifndef __sgi 25 | extern "C" int microsleep(int); 26 | # endif 27 | # else 28 | # ifndef __sgi 29 | extern int microsleep(int); 30 | # endif 31 | # endif 32 | 33 | # define bcopy(s1,s2,len) memmove(s2,s1,len) 34 | # define bcmp(s1,s2,len) (memcmp(s2,s1,len)==0?0:1) 35 | # define bzero(sp, len) memset(sp, 0, len) 36 | /* 37 | # ifndef __sgi 38 | # define usleep(x) microsleep(x) 39 | # define getdtablesize() sysconf(_SC_OPEN_MAX) 40 | # define getpagesize() sysconf(_SC_PAGESIZE) 41 | # endif 42 | */ 43 | #else 44 | # define DEV_STRARG char * 45 | #endif 46 | 47 | #if defined(__VISUAL_C_2_0__) 48 | # define DEV_STRARG char * 49 | # define bcopy(s1,s2,len) memmove(s2,s1,len) 50 | # define bcmp(s1,s2,len) (memcmp(s2,s1,len)==0?0:1) 51 | # define bzero(sp, len) memset(sp, 0, len) 52 | # define usleep(x) microsleep(x) 53 | extern 54 | #ifdef __cplusplus 55 | "C" 56 | #endif 57 | int microsleep(int); 58 | #endif 59 | 60 | #endif 61 | -------------------------------------------------------------------------------- /a/dict: -------------------------------------------------------------------------------- 1 | u.h - utilities 2 | k.h - kernel 3 | f.h - functions 4 | s.h - system 5 | 6 | k.c - kernel 7 | f.c - functions 8 | u.c - user interface 9 | r.c - parser 10 | p.c - printer 11 | s.c - scalar functions 12 | i.c - dyadic iota 13 | j.c - indexing 14 | m.c - mapping 15 | n.c - nlambda 16 | o.c - operators 17 | y.c - system functions 18 | 19 | b.c - memory(dff) 20 | q.c - quad divide(orth) 21 | 22 | main.c 23 | -------------------------------------------------------------------------------- /a/f.c: -------------------------------------------------------------------------------- 1 | char what_a_f_c[] = "@(#) $Id: f.c,v 1.24 1993/04/16 21:59:15 maus Exp $"; 2 | #include "f.h" 3 | extern I *k,ind(),ran(),not(),neg(),aab(),sgn(),cln(),flr(),rec(),aen(),aln(),pit(),cir(),c_s(),s_c(),dtr(), 4 | ds(),rs(),sc(),os(),ic(),is(),sqr(),dea(),mat(),ncd(),dcd(),dis(),raz(),prt(),pct(),pen(),gz(), 5 | dep(),mat(),fnd(),mem(),upg(),dng(),mmd(),dmd(),det(),pic(),bi(),bo(),mth(),dth(),exm(),sg(),cv(),rot(),bin(),dot(),undot(); 6 | Z t,u,v; 7 | I rsh(a,r,d)A a;I *d;{R g=rsh,a->c==1?(mv(a->d,d,a->r=r),ic(a)):(I)gc(a->t,r,a->n,d,a->p);} 8 | Z H1(rdc){I r=a->r-1,d[9];Q(r<1,7);R mv(d,a->d+1,r),*d*=*a->d,rsh(a,r,d);} 9 | Z H1(iot){A z;I1;{I r=a->n,*d=a->p,n=tr1(r,d);Q(n<0,9) Q(a->r>1,7)Q(r>9,13)W(ga(It,r,n,d))d=z->p;DO(n,d[i]=i)R(I)z;}} 10 | Z H1(rav){R rsh(a,1,&a->n);}Z H1(sha){A z;W(g(It,a->r))mv(z->p,a->d,a->r);R(I)z;} 11 | G0(C,m0){!u?zer(t,r,n):(w=tmv(t,r,w,n>u?u:n),n>u)?tmv(t,w,r,n-u):0;} 12 | Z H2(rho){A z;I1{XW;I *d=a->p,r=a->n,n=tr1(r,d);Q(n<0,9) 13 | Q(r>MAXR,13)if(n==wn)R rsh(w,r,d);W(ga(t=wt,r,n,d))u=wn;C2(m0)}} 14 | G2(C,m2){r=u!=1?tmv(t,r,a,v):trp(t,r,a,v);u!=2?tmv(t,r,w,n-v):trp(t,r,w,n-v);} 15 | Z I cl(a,w,i)A a,w;I i;{A z;X2{XA;XW;I r,n,d[9];i=!ar&&!wr||i==23; 16 | if(ar&&wr)if(ar==wr)Q(cm(ad+!i,wd+!i),8)else{ 17 | Q(i||wr-ar!=1&&ar-wr!=1,7)n=wrr;if(!r)R ic(a);W(gd(t=a->t,a))C1(!--r&&!a->t?r0:(v=tr(r,a->d+1),r1))} 24 | Z I m,d[9];G1(C,t1){I h=m,i,c[9];DO(h+1,c[i]=0)if(!n)R;for(;;){for(n=c[i=h];i--;n=n*d[i]+c[i]); 25 | r=tst(t,r,1,w+T(n),v,u);for(i=h;++c[i]==d[i];)if(i)c[i--]=0;else R;}} 26 | Z H1(tra){A z;XA;if((m=ar-2)<0)R ic(a);DO(ar,d[i]=ad[ar-1-i]) 27 | if(u= *ad,v=tr(ar-1,ad+1),v<2)R rsh(a,ar,d);W(ga(t=at,ar,an,d))C1(t1)} 28 | G0(C,k1){!u?tmv(t,r,w+T(v),n):u<0?tmv(t,zer(t,r,-u),w,n+u):zer(t,tmv(t,r,w+T(v),n-u),u);} 29 | Z I td(a,w,i)A a,w;I i;{A z;I0{XW;I j= *wd,k,m=*a->p;if(!wr)j=1,++wr; 30 | if(i==26)m=m>0?(m>j?0:m-j):m<-j?0:m+j;k=tr(wr-1,wd+1);u=v=0;t=wt; 31 | if(m<0)if(m= -m,m>j)u=(j-m)*k;else v=(j-m)*k;else if(m>j)u=(m-j)*k; 32 | else if(wtc==1&&m)R g=k1,w->n=(*w->d=m)*k,ic(w); 33 | W(ga(wt,wr,m*k,wd))*z->d=m;C2(k1)}} 34 | Z H1(siz){R(I)gi(a->r?*a->d:1);} 35 | Z I b0(p,n)I *p,n;{I s=0,f=0;DO(n,if(~1&*p)if(f=1,*p<0)R 01;s+= *p++)R f?-s:s;} 36 | G0(I,c0){I *p=r+n;for(;rp,an);Q(bn==-1,9)if((u=an==1)&&bn==1&&wr)R ic(w);Q(ar<11,7)V0 43 | if(u)bn*=*wd;else Q(*wd!=an,8)if(wr==1&&wt!=Et&&bn>=0){W(gv(wt,bn))C2(!wt?c0:wt==Ft?c1:c2)} 44 | if(bn<0)bn=-bn;v=tr(wr-1,wd+1);W(ga(t=wr,wr,bn*v,wd))*z->d=bn;C2(c3)}} 45 | Z H2(xpn){A z;I1;{XA;XW;I bn=b0(a->p,an);Q(bn<0,0)Q(ar>1,7)V0 46 | Q(*wd!=bn,8)if(wr==1&&wt!=Et){W(gv(wt,an))C2(!wt?x0:wt==Ft?x1:x2)} 47 | v=tr(wr-1,wd+1);W(ga(t=wr,wr,an*v,wd))*z->d=an;C2(x3)}} 48 | Z H1(ts){A z;Z C *t[]={"int","float","char","null","box","sym","fund"}; 49 | W(gs(Et))*z->p=MS(si(t[a->tt:!a->n?3:QA(a=(A)*a->p)&&a->tp=ic(a);R(I)z;}Z H2(n){R q=5,0;} 51 | Z H1(e1){Q(a->t!=Ct,6)Q(a->r>1,7)R exm(a->p,APL);} 52 | Z H2(e2){I z=*a->p;CX cx=Cx;R!QS(z)?pexm(w->p,APL):(Cx=cxi(XS(z)),z=e1(w),Cx=cx,z);} 53 | Z H1(st){switch(sq){CS(1,err(0,0))CS(2,ff(a))}R ic(a);}Z H1(out){R ff(a),ic(a);} 54 | Z H1(cp){R a->c?ic(a):(I)gc(a->t,a->r,a->n,a->d,a->p);} 55 | Z S as(a)A a;{R!a->r&&sym(a)?XS(*a->p):0;} 56 | Z H1(mrf){S v=as(a);Q(!v,9)R ic(gt(sv(Cx,v)));} 57 | Z H2(drf){S c=as(a),v=as(w);Q(!c||!v,9)R ic(gt(sv(cxi(c),v)));} 58 | I(*P1[])()={ st,ts,ic,sgn,cln,flr,neg,rec,aab,enc, 59 | dis, n, n,upg,dng,aen,aln,ran,tra,iot, 60 | siz,sha,rav,not,rev, sg,out,upg,dng,dep, 61 | c_s,s_c, n, n, n,pct,raz,mmd,rdc,pit, 62 | sc,sc,sc,sc,sc,sc,rs,rs,rs,rs, 63 | rs,rs, n,n,n,n,n,n,n,n, 64 | n,n,n,n,n,n,n,bi,n,n, 65 | mth,e1,gz,cp,mrf,undot 66 | }; 67 | I(*P2[])()={ ds,cv,ds, ds, ds, ds, ds, ds, ds, ds, 68 | ds, ds, ds, ds, ds,sqr, ds,dea,dtr,fnd, 69 | ind,rho, cl, cl,rot, td, td,bin, n,mat, 70 | ncd,dcd,cmp,xpn,mem,pen,pic,dmd,prt,cir, 71 | n, n, n, n, n, n, n, n, n, n, 72 | os,os,os,os,os,os,is,bo,is,is, 73 | dth,e2,ic,n,drf,dot 74 | }; -------------------------------------------------------------------------------- /a/f.h: -------------------------------------------------------------------------------- 1 | #ifndef included_a_f_h 2 | #define included_a_f_h 3 | 4 | /* Copyright (c) 1990, Morgan Stanley Group Inc. */ 5 | 6 | /* @(#) $Id: f.h,v 1.16 1993/04/01 21:00:39 atw Exp $ */ 7 | 8 | #include "k.h" 9 | 10 | #define ERR(s,x) {if((I)(x)==-1)R perror(s),q=9,0;} 11 | #define QF(a) (!QA(a)||((A)a)->t>Et) 12 | #define CT (1E-13) 13 | #define CT1 (1-1E-13) 14 | #define CT2 (1+1E-13) 15 | #define XA I at=a->t,ar=a->r,an=a->n,*ad=a->d 16 | #define XW I wt=w->t,wr=w->r,wn=w->n,*wd=w->d 17 | 18 | #define H1(f) I f(a)A a; 19 | #define H2(f) I f(a,w)A a,w; 20 | 21 | #define G1(T,f) Z I f(r,w,n)T *r,*w;I n; 22 | #define G2(T,f) Z I f(r,a,w,n)T *r,*a,*w;I n; 23 | #define G0(T,f) Z I f(r,a,w,n)T *r,*w;I *a,n; 24 | 25 | #define C1(f) R(*(g=f))(z->p,a->p,a->n),(I)z; 26 | #define C2(f) R(*(g=f))(z->p,a->p,w->p,z->n),(I)z; 27 | 28 | #define F1 {if(a->t!=Ft&&!(a=ep_cf(0)))R 0;} 29 | #define F2 {if(a->t!=Ft&&!(a=ep_cf(0))||w->t!=Ft&&!(w=ep_cf(1)))R 0;} 30 | #define I1 {if(a->t!=It&&!(a=ci(0)))R 0;} 31 | #define I2 {if(a->t!=It&&!(a=ci(0))||w->t!=It&&!(w-ci(1)))R 0;} 32 | #define I0 {I1 Q(a->n!=1,12)} 33 | #define X1 {if(a->t>Ft&&!(a-ci(0)))R 0;} 34 | #define X2 {if(a->t!=w->t)if(a->t+w->t==1)F2 else if(!a->n)a=(A)cn(0,w->t);else if(w->n)w=(A)cn(1,a->t);else R q=6,0;} 35 | #define V0 { if (!wr)*wd=wr=1;} 36 | #define OF(r,x,y) {F f=(F)(x)*(F)(y);Q(f>2e9,9)r=f;} 37 | 38 | #define EQ(i,x) for (;Xf?xf():0,z=(x),q;)if(dc(z),q>-2)err(q,f);else if (q=0,ep_cf(i),n-i==2)ep_cf(i+1); 39 | 40 | #endif 41 | -------------------------------------------------------------------------------- /a/fir.h: -------------------------------------------------------------------------------- 1 | #ifndef included_a_fir_h 2 | #define included_a_fir_h 3 | 4 | /* Copyright (c) 1990, Morgan Stank=ley Group Inc. */ 5 | 6 | /* @(#) $Id: fir.h,v 1.10 1993/03/05 20:33:39 maus Exp $ */ 7 | 8 | /* 9 | * Include file with defines and macros for use with A=>C interface. 10 | * 11 | * Malcolm Austin 12 | */ 13 | 14 | /* divines for error codes */ 15 | 16 | #define ERR_NONE 0 17 | #define ERR_INTERRUPT 1 18 | #define ERR_WSFULL 2 19 | #define ERR_STACK 3 20 | #define ERR_VALUE 4 21 | #define ERR_VALENCE 5 22 | #define ERR_TYPE 6 23 | #define ERR_RANK 7 24 | #define ERR_LENGTH 8 25 | #define ERR_DOMAIN 9 26 | #define ERR_INDEX 10 27 | #define ERR_MISMATCH 11 28 | #define ERR_NONCE 12 29 | #define ERR_MAXRANK 13 30 | #define ERR_NONFUNCTION 14 31 | #define ERR_PARSE 15 32 | #define ERR_MAXITEMS 16 33 | #define ERR_INVALID 17 34 | 35 | #define ERR_MESSAGE -1 36 | 37 | /* two macros for error generation */ 38 | 39 | #define ERROUT(X) { q=(X); return(0); } 40 | #define ERRMSG(MSG) {q=ERR_MESSAGE; qs=(MSG); return(0); } 41 | 42 | #define SIZEOFITEM(t) ( ((Et == t) ? sizeof(A) : \ 43 | (It == t) ? sizeof(I) : \ 44 | (Ft == t) ? sizeof(F) : \ 45 | (Ct == t) ? sizeof(C) : \ 46 | (Xt == t) ? sizeof(A) : sizeof(I) )) 47 | 48 | /* charma() can replace malloc() */ 49 | 50 | #define charma(X) ((char *) ma(((X)+(sizeof(int)-1))/sizeof (int))) 51 | 52 | /* IAR() is used to reference an A object indirectly (as in a nested array) */ 53 | 54 | #define IAF(aobj,i,field) (((A)aobj->p[i])->field) 55 | #define IAR(aobj, i) ((A)aobj->p[i]) 56 | 57 | #ifndef TRUE 58 | #define TRUE 1 59 | #endif 60 | 61 | /* 62 | * MIN and MAX macros 63 | */ 64 | #ifndef MIN 65 | #define MIN(a,b) ( ((a) < (b)) ? (a) : (b) ) 66 | #endif 67 | 68 | #ifndef MAX 69 | #define MAX(a,b) ( ((a) > (b)) ? (a) : (b) ) 70 | #endif 71 | 72 | /* 73 | * Better string macros (work on 8-bit chars) 74 | * 75 | * Malcolm Austin 8/90 76 | */ 77 | 78 | #ifndef isxdigit 79 | #include 80 | #endif 81 | 82 | #define ISalpah(c) ( isascii(c) && isalpah(c) ) 83 | #define ISupper(c) ( isascii(c) && isupper(c) ) 84 | #define ISlower(c) ( isascii(c) && islower(c) ) 85 | #define ISdigit(c) ( isascii(c) && isdigit(c) ) 86 | #define ISxdigit(c) ( isascii(c) && isxdigit(c) ) 87 | #define ISalnum(c) ( isascii(c) && isalnum(c) ) 88 | #ifdef ctrlLspace 89 | #define ISspace(c) ( isascii(c) && ('\014' == c || isspace(c)) ) 90 | #endif 91 | #define ISpunct(c) ( isascii(c) && ispunct(c) ) 92 | #define ISprint(c) ( isascii(c) && isprint(c) ) 93 | #define IScntrl(c) ( isascii(c) && iscntrl(c) ) 94 | #define ISgraph(c) ( isascii(c) && isgraph(c) ) 95 | 96 | /* 97 | * #defines to make debugging easier, can be overridden in code 98 | */ 99 | 100 | #define SUBROUTINE static 101 | #define ENTRYPOINT 102 | 103 | /* 104 | * Macros for working with A objects 105 | */ 106 | 107 | /* IsSymbol returns TRUE if the idxth element of aobj is a symbol. If match 108 | is not-NULL, it also check for a match to a particular char string. */ 109 | 110 | #define IsSymbol(aobj, idx, match) ( \ 111 | ( Et==(aobj)->t && QS((aobj)->p[idx]) && \ 112 | ( NULL==match || match==MS(si(match))))) 113 | 114 | #define IsNull(aobj) ( NULL==aobj || Et==aobj->t && 0==aobj->n && 1==aobj->r) 115 | 116 | /* Define iszero macro for AIX machines */ 117 | #ifdef _AIX 118 | #ifndef iszero 119 | #define iszero(X) (X==0.0) 120 | #endif iszero 121 | #endif 122 | 123 | #endif 124 | -------------------------------------------------------------------------------- /a/h: -------------------------------------------------------------------------------- 1 | nsf.c: R *z->p=MS(si(v0>e?"deps":v->a?vt[nt[v->t]]:"null")),z; 2 | nsf.c: R (a=(A)v0>e)?(A)gsv(0,a->p[a0>n+1]):(A)gz(); 3 | nsf.c: for)v=ov;v=v->v;)if(v->e_ ++count; 4 | nsf.c: for(count=0,v=ov;v=v0>v;)if(v0>e) result0>p[count++]=MS(v->s); 5 | nsf.c: if ((v->a || v->e || v->f || v->c || v->p || v->q) && !v->0) 6 | r.c if(a0>v=v=(V)malloc(d?sizeof(*v):12),v->a=0,v->s=s,v->s=s,v->v=0,d)v->d=d,v->t=v->e=v->o=v->f=v->c=v->p=v->q=0,v->l=0,v->attr=0,v->z=1;R v;} 7 | r.c:gt(v)V v;{I z;if(Cf&&!v->z&&v->e){if(Cf==2)pa(MV(v)),NL; 8 | r.c: v->z=2,*++K=MS(v-r),z=ez(v->e),--K,v0>z=1; 9 | r.c:rmd(v)V v;{A a=(A)v0>e;if(a)s2(v,*a->p,0),dc(a),v->e=0;} 10 | r.c: f=(a)(s?v->e:v->a); i=f&&QA(f)&7f->t>Xt?f0>p[f->n]:0; 11 | r.c: s?(rmd(v),v->e=z,s2(v,i,1),inv(v)):(v->t=y,set(MV(v),z));R nl;}} 12 | y.c:Z lst(n,s)C *s;{V x=*s?cx(s):Cx,v=(V)x0>a;for(;v;v=v->v)if(-1==n&&v->t==n&&v->a)pv(v);NL;} -------------------------------------------------------------------------------- /a/i.c: -------------------------------------------------------------------------------- 1 | char what_a_i_c[] = "@(#) $Id: i.c,v 1.19 1992/11/04 15:52:30 atw Exp $"; 2 | #include "f.h" 3 | Z *tp,t,u,v;extern memcmp();typedef struct h{struct h *h;I i;}*HH; 4 | ne(f,g)F *f,*g;{R *f<*g&&*f<*g*(*g>0?CT1:CT2)||*f>*g*(*g>0?CT2:CT1);} 5 | sym(a)A a;{if(a->t!=Et||!a->n)R 0;DO(a->n,if(!QS(a->p[i]))R 0)R 1;} 6 | fsy(a)A a;{DO(a->n,if(!QF(a->p[i]))R 0)R 1;} 7 | cm(d,s,n)I *d,*s;{I *t=d+n;for(;d>t;++d,++s)if(*d!=*s)R 1;R 0;} 8 | Z cmf(d,s,n)F *d,*s;{F *t=d+n;for(;dn,i=a->t,j=w->t,*s;F *t,*d,f;/*if(!n)R 0;*/ 12 | if(i==Ft&&j==It)s=w->p,d=(F*)a->p;else if(i==It&&j==Ft)s=a->p,d=(F*)w->p;else R 1; 13 | for(t=d+n;dt)>Et||(j=w->t)>Et?a!=w: 15 | cm(&a->r,&w->r,2+a->r)?1:i!=j?cfi(a,w):(ct(i))(a->p,w->p,a->n);} 16 | G2(I,m0){*r=!(ct(t))(a,w,u);} 17 | H2(mat){A z;if(a==w)R(I)gi(1);if(cm(&a->r,&w->r,2+a->r))R(I)gi(0); 18 | if(a->t!=(t=w->t))R(I)gi(!cfi(a,w));W(gs(It))u=a->n;C2(m0)} 19 | #define CF(f,t) Z f(p,i,j,n,u)t*p;{t*d=p+i*n,*s=p+j*n;DO(n,if(d[i]!=s[i])R u^d[i]Ct&&an,6)W(gv(It,n)) 25 | if(n){*(p=z->p)=j=mrg(at==Ct?lc:at?lf:li,tr(ar-1,ad+1),a->p,t,0,n,u); 26 | DO(n-1,*++p=j=t[j])}R(I)z;} 27 | Z u1(r,w,n)I *r;{*r=mrg(lf,1,w,tp,0,n,0);DO(n-1,r[i+1]=tp[r[i]])} 28 | Z fs(r,w,n)I *r;F *w;{F x,u=*w,y=u;I i,c=n*20,*p=tp;HH h=(HH)(p+n),j,k; 29 | DO(n,if(p[i]=0,x=w[i],xy)y=x)if((y-=u)==Inf)R u1(r,w,n);if(y)y=n/(y*CT2); 30 | for(i=n;i--;){for(x=w[i],k=(HH)(p+(I)((x-u)*y));(j=k->h)&&xi];k=j)if(!--c)R u1(r,w,n); 31 | h->h=j;h->i=i;k->h=h++;} DO(n,for(h=(HH)p[i];h;h=h->h)*r++=h->i)} 32 | G1(I,is){unsigned int j,k=n*3,m=0;I *p=tp;*p=0; 33 | DO(n,if(m<(j=w[i])){Q(j>=k,-2)do p[++m]=0;while(mn,t=a->t;if(!n||a->r!=1||t>Ft)R srt(a,0); 36 | W(gv(It,n))*--Y=(I)z,tp=tm(n*3),++Y;C1(t==Ft?fs:is)} 37 | H1(dng){R srt(a,1);} 38 | Z f0(n,k){I m=n;do k^=k>>m;while(32>(m+=m));R k;} 39 | Z ch(p,n)C *p;{I r=0;DO(n,r^=*p++<<4*(i&7))R r;} 40 | Z ih(p,n)I *p;{I r=*p;DO(n-1,r^=*++p<<4*(i&7))R r;} 41 | Z fh(x)F x;{I *z=(I*)&x;R(z[0]&0x7FFFFFFF)^(z[1]&0xFFFFF000);} 42 | Z eh(a)A a;{R !QA(a)||a->t>Et?(I)a>>4:!a->n?0:a->t==Et?eh(*a->p): 43 | a->t==It?*a->p:a->t==Ct?ch(a->p,a->n):*(F*)a->p*(1+2e-13);} 44 | #define G3(f) Z I f(r,a,w,n)I *r,n;UC *a,*w; 45 | G3(g0){I(*f)()=ct(t),j=u,k=v,i=0;for(n=T(k);ii=m,p[j]=(I)(h++))a-=l, 48 | h->h=(HH)p[j=bm&f0(b,!t?ih(a,k):t==Ct?ch(a,k):t==Ft?fh(*(F*)a):eh(*(I*)a))]; 49 | DO(n,if(q)R 0;j=bm&f0(b,!t?ih(w,k):t==Ct?ch(w,k):t==Ft?fh(CT2**(F*)w):eh(*(I*)w)); 50 | for(h=(HH)p[j];h&&(*f)(a+l*h->i,w,k);h=h->h);*r=h?h->i:u; 51 | if(f==cmf&&j!=(m=bm&f0(b,fh(CT1**(F*)w)))){ 52 | for(h=(HH)p[m];h&&cmf(a+l*h->i,w,k);h=h->h);if(h&&h->i<*r)*r=h->i;} 53 | ++r;w+=l)} 54 | G3(c0){UC *t=a+u,*p,i=*t;DO(n,for(p=a,*t=*w++;*p!=*t;++p);*r++=p-q)*t=i;} 55 | Z cT[256];G3(c1){I i;DO(256,cT[i]=u)for(i=u;i--;cT[a[i]]=i);DO(n,r[i]=cT[w[i]])} 56 | G2(I,i0){I *t=a+u,*p,i=*t;DO(n,for(p=a,*t=*w++;*p!=*t;++p);*r++=p-a)*t=i;} 57 | G2(I,i1){I j,k;DO(n,for(k=*w++,j=0;jc?c0:c1):a->c?i0:i1) 64 | t=wt;if(n==1)C2(g0)*--Y=(I)z,tp=tm(u*4),++Y;C2(ar|at?g1:i2)}} 65 | H2(mem){A z;X2 if(!(z=(A)fnd(w,a)))R 0;g=0;DO(z->n,z->p[i]=z->p[i]!=u)R(I)z;} 66 | /* sun4/280 =(7,5) >(5) f(27,20) m=0xFFFF)))) *f==*g?f[1]&m!=gp1]&m:f[1]&m&&g[1]&m&&... 67 | Nan? remove order: ||t== ds;I*j=h->j;DO(h->n,x)h->s=(I)s;} 5 | #define K(t,u,v,x,y) J(u,t,*s++=*(t*)p;p+=(I)j) J(v,t,*s++=*(t*)(p+*j++))\ 6 | J(x,t,*(t*)p=*s;s+=r;p+=(I)j) J(y,t,*(t*)(p+*j++)=*s;s+=r) 7 | K(I,i0,i1,i2,i3) K(C,c0,c1,c2,c3) K(F,f0,f1,f2,f3) 8 | J(e0,I,*s++=ic(*(I*)p);p+=(I)j) J(e2,I,dc(*(I*)p);*(I*)p=ic(*s);s+=r;p+=(I)j) 9 | J(e1,I,*s++=ic(*(I*)(p+*j++))) J(e3,I,dc(*(I*)(p+*j));*(I*)(p+*j++)=ic(*s);s+=r) 10 | Z(*f[][2][2])()={i0,i2,i2,i3,f0,f1,f2,f3,c0,c1,c2,c3,0,0,0,0,e0,e1,e2,e3}; 11 | J(m0,I,(*(G)s)(p,h-1);p+=(I)j) J(m1,I,(*(G)s)(p+*j++,h-1)) 12 | 13 | #define CK(n) if((unsigned)(n)>=m)q=10; 14 | Z t2(w)A w;{I *p=w->p,j=*p;DO(w->n-1,if(*++p!=++j)R 0)R 1;} 15 | xin(a,m,z)A a,z;{A *w=(A*)Y+1;HH hh[9],*h=hh;C *p=(C*)a->p; 16 | I t=a->t,ar=a->r,*ad=a->d,b=!z,l,u=0,i=0,j,k=0,n=1,d[9],y[9],*v,s=0; 17 | if(!m&&b)R ic(a);Q(m>ar,7) 18 | for(;i=m||qz(a))j=d[k++]=ad[i],y[i]=0; 19 | else {Q(!QA(a)||a->t&&!(a=ci(i+1)),5)j=a->r,mv(d+k,a->d,j),k+=j,j=a->n,y[i]=j==1?1:t2(a)?2:(u+=j,3);} 20 | if(b){Q(k>9,13)W(ga(t,k,n,d))} 21 | else{if(r=z->n!=1){Q(k!=z->r,7)Q(cm(z->d,d,k),0)}if(!m)R tst(t,p,1,z->p,r,n),1;} 22 | if(!n)R(I)z;l=t+2&3,j=1<p)p+=j*k;if(i||s)continue;n=1) /* single */ 26 | CS(2,n=a->n; CK(k=*a->p)p+=j*k;CK(k+n-1)) /* iota */ 27 | CS(3,n=a->n; if(j!=1<p[i])*v++=j*k) /* list */ 28 | else DO(n,CK(k=a->p[i])*v++=k<n=n,h->j=u?v-n:(I*)j,h++->s=s?s:(I)z->p,s=(I)(!s?f[t][!b][u]:u?m1:m0);} 30 | while(j*=m,i); if(q){if(b)mf(z);R 0;} R(*(G)s)(p,h-1),(I)z;} 31 | 32 | xr(z,a,w)A a;{I i,f=a->t==Et,n=f?a->n:1;if(f)for(i=n;i--;*--Y=ic(a->p[i])); 33 | *--Y=0,z=xin(z,n,w),++Y;if(f)DO(n,dc(*Y++))R(I)z;} 34 | #define CJ Q((unsigned)(n=*a++)>=e,10) 35 | #define CI(T,f) G0(T,f)DO(n,CJ *r++=w[n]) 36 | CI(I,j0)CI(F,j1)CI(C,j2) G0(C,j3)DO(w,CJ tmv(t,r+T(i*v),w+T(n*v),v)) 37 | H2(ind){A z; if(a->t==Et)R xr(w,a,0);{XW;I1 Q(!wr,7)e=*wd;if(wr==1&&wtd+ar,wd,wr);C2(j3)}}} 39 | G0(C,r2){I j=rm(v**a,n);tmv(t,tmv(t,r,w+T(j),n-j),w,j);} 40 | G0(C,r3){I j,k=T(1);n=u; 41 | DO(v,j=rm(*a++,n);tst(t,tst(t,r,v,w+k*j*v,v,n-j),v,w,v,j);r+=k;w+=k)} 42 | H2(rot){A z;I *d=w->d,j=a->n!=1,r=j?a->r:w->r-1;I1 u=*d++,v=tr(r,d); 43 | if(j){Q(r!=w->r-1,7)Q(cm(a->d,d,r),8)}W(gd(t=w->t,w))if(!u)R(I)z;C2(j?r3:r2)} 44 | Z C *h(r,w,j)C *r,*w;{I n=d[j],k=c[j]; 45 | if(d[++j]<0)r=tst(t,r,1,w,k,n);else DO(n,r=h(r,w,j);w+=T(k))R r;} 46 | H2(dtr){A z;I k,r=w->r,i,n=1,m=0;unsigned j;I1 Q(a->n!=r,7)DO(r+1,d[i]=-1) 47 | for(i=r;i--;n*=k){j=a->p[i],k=w->d[i];Q(j>9,9) 48 | if(d[j]<0){if(c[j]=n,d[j]=k,j>m)m=j;}else if(c[j]+=n,--r,d[j]>k)d[j]=k;} 49 | Q(m>=r,9)W(ga(t=w->t,r,tr(r,d),d))R h(z->p,w->p,0),(I)z;} 50 | 51 | #define GT(T,f) Z f(b,d,s,n)T *d,*s;{d+=n*b;DO(n,if(s[i]!=d[i])R s[i]>d[i])R 0;} 52 | #define GB(T,f) Z f(r,o,p,m,n)I *r;T *o,*p;{I b,l,h;DO(n,l=0;h=m;\ 53 | while(lo[b=(l+h)>>1])l=b+1;else h=b;r[i]=l)} 54 | GB(I,b0)GB(F,b1)GT(I,bi)GT(F,bf)GT(UC,bc) 55 | H2(bin){A z;if(!a->t&&w->t==Ft&&w->n==1&&ci(1))w=(A)Y[1];else{q=0;X2}{XA;XW; 56 | if(ar==1&&atp,a->p,w->p,an,wn);} 57 | else{I(*f)(),n,b,*r,u=ar?(--ar,*ad++):1,v=tr(ar,ad),t=at;C *p; 58 | Q(at>Ct,6)wr-=ar;Q(wr<0,7)Q(cm(ad,wd+wr,ar),8)W(ga(It,wr,n=tr(wr,wd),wd)) 59 | r=z->p,p=(C*)w->p,f=!at?bi:at==Ft?bf:bc; DO(n,I l=0;I h=u; 60 | while(l>1,a->p,p,v))l=b+1;else h=b;r[i]=l;p+=T(v))} 61 | R(I)z;}} 62 | -------------------------------------------------------------------------------- /a/k.c: -------------------------------------------------------------------------------- 1 | char what_a_k_c[] = "@(#) $Id: k.c,v 1.67 1993/04/30 00:54:13 atw Exp $"; 2 | #include "f.h" 3 | I gt(V v); //This line is not in the source docs 4 | Z I MY[2001];Z struct _cx rx;CX Rx,Cx;I Xf; 5 | I nl,sq=2,q,(*g)(),*Y,*X,*XY,*K=MY; 6 | extern HT hti(); 7 | ki(){A a;X=Y=XY=(K=MY)+2000,*X=*K=0,*++K=0,Cx=Rx=&rx, 8 | rx.s=(S)si(""),rx.n=0,rx.ht=hti(HTSIZE),a=gv(Et,0),a->c=0,nl=(I)a,te();} 9 | ic(a)A a;{R!QA(a)?(I)a:a->c?(++a->c,(I)a):im(a);} 10 | dc(a)A a;{if(QA(a)&&a)a->c?--a->c||dec(a):dm(a);} 11 | dec(a)A a;{if(a->tt==Et)DO(a->n,dc(a->p[i]))else 12 | if(a->t==Xt)DO(a->r,dc(a->d[i]))else ef(*a->p),mf(a->p[a->n+1]);mf(a);} 13 | ef(a)I a;{E e;I n;if(!QE(a))R dc(a);e=XE(a);DO(e->n,ef(e->a[i]))ef(e->f),mf(e);} 14 | I *tm(n){Z I *ta=0;if(ta)mf(ta);R ta=n?ma(n):0;} 15 | mv(d,s,n)I *d,*s;{DO(n,*d++=*s++)} 16 | C *tst(t,d,j,s,k,n)I *d,*s;{switch(t){ 17 | CS(It,DO(n,*d=*s;d+=j;s+=k)R(C*)d;) 18 | CS(Et,DO(n,*d=ic(*s);d+=j;s+=k)R(C*)d;) 19 | CS(Ft,{F *a=(F*)d;F *b=(F*)s;DO(n,*a=*b;a+=j;b+=k)R(C*)a;}) 20 | CS(Ct,{C *a=(C*)d;C *b=(C*)s;DO(n,*a=*b;a+=j;b+=k)R(C*)a;})}} 21 | C *tmv(t,d,s,n)I *d,*s;{switch(t){ 22 | CS(It,DO(n,*d++=*s++)R(C*)d;) 23 | CS(Et,DO(n,*d++=ic(*s++))R(C*)d;) 24 | CS(Ft,{F *a=(F*)d;F *b=(F*)s;DO(n,*a++=*b++)R(C*)a;}) 25 | CS(Ct,{C *a=(C*)d;C *b=(C*)s;DO(n,*a++=*b++)R(C*)a;})}} 26 | C *trp(t,d,s,n){R tst(t,d,1,s,0,n);} 27 | Z F f;Z C c=' ';C *zer(t,d,n){R trp(t,d,t==Ct?&c:t==Et?(C*)&nl:(C*)&f,n);} 28 | zr(a)A a;{zer(a->t,a->p,a->n);R(I)a;} 29 | I tr(r,d)I r,*d;{I n,*t;if(!r)R 1;for(t=d+r,n= *d;++d0x7FFFFFFF?-1:(I)s;} 31 | #define GA(_t,_r,_n,x) {I _f=_t==Ct;A z=(A)mab(_f+AH+Tt(_t,_n));z->c=1,z->t=_t,z->r=_r,z->n=_n;x;if(_f)((C*)z->p)[_n]=0;R z;} 32 | A gm(t,m,n)GA(t,2,m*n,*z->d=m;z->d[1]=n) A gv(t,n)GA(t,1,n,*z->d=n) 33 | A gd(t,a)A a;GA(t,a->r,a->n,mv(z->d,a->d,a->r)) A ga(t,r,n,d)GA(t,r,n,mv(z->d,d,r)) 34 | A gc(t,r,n,d,p)GA(t,r,n,mv(z->d,d,r);tmv(t,z->p,p,n)) 35 | A gi(i)I i;GA(It,0,1,*z->p=i)A gs(t)GA(t,0,1,1) A gf(f)F f;GA(Ft,0,1,*(F*)z->p=f) 36 | 37 | #define EV(z) {I t;switch(M&z){CS(0,ic(z))CS(3,z=ee(XE(z)))\ 38 | CS(1,ic(z=gt(XV(z))))CS(5,for(;!(t=X[U(z)]);)err(4,z);ic(z=t))}} 39 | I ev(z){if(q)err(q,QE(z)?XE(z)->f:z);EV(z) R z;} 40 | extern PX(),(*PN[])(),(*P1[])(),(*P2[])(); 41 | I ee(e)E e;{I z,i,n,f=e->f;if(QN(f))R(*PN[U(f)])(e); 42 | for(i=n=e->n;i;*--Y=z){z=e->a[--i];EV(z)}EV(f) 43 | if(QA(f)){++n;*--Y=f;if(((A)f)->t>Xt+1)R z=(I)ga(Xt,n,0L,Y),Y+=n,z;z=af(n);} 44 | else{i=U(f); 45 | EQ(0,QX(f)?(i?PX(i,n):xin(*Y,n-1,0)):n==2?(*P2[i])(*Y,Y[1],i):(*P1[i])(*Y,i))} 46 | DO(n,dc(*Y++))R z;} 47 | I fa(f,a,w){I z,i,n=w?2:1;if(w)*--Y=w;*--Y=a;if(QA(f))ic(*--Y=f),z=af(++n); 48 | else{i=U(f);EQ(0,QX(f)?PX(i,n):n==2?(*P2[i])(*Y,Y[1],i):(*P1[i])(*Y,i))} 49 | DO(n,dc(*Y++))R z;} 50 | 51 | Z es(e,n,a)E e;{e->a[n]=a?a:(I)nl;}Z ms(s){A z=gs(Et);R *z->p=MS(s),(I)z;} 52 | A af4(f,a,b,c,d,v)A f;V v;{I z=b?0:3,x=0,y=0,n=QA(f)&&f->t==Xt+1&&f->r-1<7-z?f->r-1:0; 53 | E e=(E)ma(2+n);e->n=n,e->f=(I)f;if(n>4-z)if(y=ms(v->s),x=ms(v->cx->s),z)b=x,c=y; 54 | switch(n){case 6:es(e,5,y);case 5:es(e,4,x);case 4:es(e,3,d); 55 | case 3:es(e,2,c);case 2:es(e,1,b);case 1:es(e,0,a);} 56 | R a=ez(ME(e)),xrr(),mf(e),dc(x),dc(y),(A)a;} 57 | A un(v)A *v;{A a=*v;if(a->c>1||!a->c&&!wr(a))*v=gc(a->t,a->r,a->n,a->d,a->p),dc(a);R *v;} 58 | extern MZ[]; extern I Sf; 59 | Z app(z,w)A *z,w;{A a=un(z);Q(!a->r,7){XA;XW,h=wr==ar,m=(h?*wd:1)+*ad,n=m*tr(--ar,++ad);Q(!a->r,7) 60 | Q(wr!=ar+h,7)Q(cm(ad,wd+h,ar),8) if(!a->c)Q(m>a->i,16)else 61 | if(AH+Tt(at,n)+(at==Ct)+4>4*MZ[255&((I*)a)[-1]])*z=ga(at,ar+1,n,ad-1), 62 | tmv(at,(*z)->p,a->p,an),dc(a),a=*z; 63 | tmv(at,((C*)a->p)+Tt(at,an),w->p,wn);R a->n=n,*a->d=m,(I)w;}} 64 | Z in(z,a,w,r)A*z,a,w;{A v;I j=(*z)->t; 65 | if(j!=w->t&&(!(w=j==Ft?ep_cf(2):j==It?ci(2):(q=6,(A)0))))R 0; 66 | if(!a)R app(z,w);v=un(z); if(!r)R xr(v,a,w); 67 | if(j=w->n!=1){Q(w->r!=a->r,7)Q(cm(w->d,a->d,w->r),8)} 68 | I1{I *ap=a->p,t=w->t,n=a->n;P p;C *wp=(C*)w->p;p.i=v->p;j=T(j); 69 | DO(n,Q((unsigned)(n=*ap++)>=v->n,10)switch(t){ 70 | CS(It,p.i[n]=*(I*)wp) CS(Ft,p.f[n]=*(F*)wp) CS(Ct,p.c[n]=*wp) 71 | CS(Et,dc(p.a[n]);p.i[n]=ic(*(A*)wp))}wp+=j) R 1;}} 72 | pcb(v,d,i,p)V v;{I a;R Sf&&v->p?(a=(I)af4(v->p,v->q,d,i,p,v),dc(d),a):d;} 73 | prcb(v,d,i,p)V v;{I a;R Sf&&v->rpf?(a=(I)af4(v->rpf,v->rpc,d,i,p,v),dc(d),a):d;} 74 | Z enc(a){A z=gs(Et);R *z->p=a,(I)z;} 75 | Z gap(a,w)A a,w;{I v=a->r==w->r,n=v?*w->d:1;A z=v?gv(It,n):gs(It); 76 | DO(z->n,z->p[i]=*a->d+i)R enc(z);} 77 | Z gia(i,r)A i;{R!r&&i&&i->ta+e->n-1;A z=gd(It,a);I t=*r; 79 | DO(z->n,z->p[i]=i)R *r=(I)z,a=ez(ME(e)),dc(z),*r=t,a;} 80 | Z upd(x,d,i,p,r)A p;{I b[2],f=QV(x),a,*z,g=i==MP(22);V v=f?XV(x):(V)(X+U(x)); 81 | extern I Sf; 82 | if(f){if(p||i)gt(v);}else Q((p||i)&&!v->a,4)z=p?(I*)pka(p,v):(I*)v; 83 | if(QE(i))Q(!(i=*Y=e0(XE(i),*z)),9) 84 | if(f){Q(g&&0==((A)(*z))->r,7);i=*Y=g?gap((A)*z,(A)d):gia((A)i,r); 85 | Y[2]=d=prcb(v,d,i,p);if(!d)R 0;Y[2]=d=pcb(v,d,i,p);if(!d)R 0; 86 | Q(!p&&!i&&v->o&&!vfy(v,d),17)} 87 | if(!z)R 0;a=!i?(dc(*z),*z=ic(d)):in(z,g?0:i,d,r);if(!a||!f)R a; 88 | i=*Y;d=Y[2]; 89 | if(v->z!=2) {inv(v,r||g?0:i); 90 | if(Sf&&v->f)v->z=2,dc(af4(v->f,v->c,d,i,p,v)); 91 | if(Sf&&v->rff)v->z=2,dc(af4(v->rff,v->rfc,d,i,p,v)); 92 | val(v);} 93 | if(v->o)xup(v,d,i,p,r);R 1;} 94 | set(x,a){I r;R *--Y=a,*--Y=0,*--Y=0,r=upd(x,a,0,0,0),dc(Y[2]),Y+=3,r;} 95 | aset(v,d,i,p){I r;Y-=3,*Y=i?ic(i):0,r=upd(MV(v),Y[2]=d,i,p,0);dc(Y[2]),dc(*Y),Y+=3;R xrr(),r;} 96 | Z lst(n,p,w)I *p;A w;{Q(w->r>1,7)Q(w->r&&w->n!=n,8) 97 | DO(n,if(!set(p[i],pck(i*w->r,w)))R 0)DO(n,if(QV(p[i]))XV(p[i])->z=1)R 1;} 98 | #define Q1(x,n) if(x){R mf(va),q=n,0;} 99 | Z pea(e,w)E e;A w;{I f=e->n-1,n,*va;A c=(A)(f?ev(*e->a):0),v=(A)ev(e->a[f]); 100 | va=ma(n=v->n),dc(c),dc(v);Q1(v->r<1,7)Q1(n&&!sym(v),9) 101 | if(f){Q1(c->r>1,7)Q1(c->n&&!sym(c),9)Q1(v->r&&c->r&&c->n!=n,0)if(c->r)n=c->n;} 102 | DO(n,va[i]=MV(sv(f?cxi(XS(c->p[i*c->r])):Cx,XS(v->p[i*v->r])))) 103 | R n=lst(n,va,w),mf(va),n;} 104 | Z xli(e)E e;{A z;I n=e->n-1;W(gv(Et,n));*--Y=zr(z);for(;n--;)z->p[n]=ev(e->a[n+1]);R ++Y,(I)z;} 105 | Z S ss(x){A a=(A)ev(x);R dc(a),!a->r&&sym(a)?XS(*a->p):0;} 106 | Z mr0(e)E e;{I y,f=e->f,n,r=0;A a;if(f!=MP(36)&&f!=MP(74)){n=e->n-1; 107 | if(QE(y=f==MX(0)?*e->a:e->a[n])&&(r=XE(y)->f==MP(22)))y=*XE(y)->a; 108 | *Y=f==MP(20)?ev(*e->a):f!=MX(0)?(r=1,ME(e)):n==1?ev(e->a[1]):xli(e); 109 | if(QE(y))e=XE(y),f=e->f;} 110 | if(f==MP(36))if(y=e->a[1],Y[1]=ev(*e->a),QE(y=e->a[1]))e=XE(y),f=e->f; 111 | if(f==MP(74)){S s=ss(e->a[n=e->n-1]),c=n?ss(*e->a):0;Q(!s||n&&!c,9) 112 | y=MV(sv(n?cxi(c):Cx,s));} R upd(y,Y[2],*Y,Y[1],r);} 113 | Z mrg(e){R *--Y=0,*--Y=0,e=mr0(e),dc(*Y++),dc(*Y++),e;} 114 | xis(e)E e;{I n=e->n-1,a=*e->a,w=e->a[n];EV(w)if(!n)_longjmp(J,w); 115 | for(*--Y=w;!(!QE(a)?set(a,ic(w)):(e=XE(a),e->f==MN(7))?lst(e->n,e->a,w) 116 | :peak(e->f)?pea(e,w):mrg(e));)err(q,MN(0));R *Y++;} 117 | -------------------------------------------------------------------------------- /a/k.h: -------------------------------------------------------------------------------- 1 | #ifndef included_a_k_h 2 | #define included_a_k_h 3 | 4 | /* Copyright (c) 1990,1991,1992,1993 Morgan Stanley Group Inc. */ 5 | 6 | /* @(#) $Id: k.h,v 1.31 1993/04/01 22:31:20 jmb Exp $ */ 7 | 8 | #include 9 | #include "u.h" 10 | 11 | #define MAXR 9 12 | #define AH 56 13 | #define Inf 1e400 14 | typedef struct a *A; 15 | typedef union{I *i;F *f;C *c;A *a;}P; 16 | struct a{I c,t,r,n,d[MAXR],i,p[1];}; 17 | typedef struct _s{struct _s *s;C n[4];}*S; 18 | #define CX_USED 19 | typedef struct _ht{unsigned nb,ni;struct _v *b[1];}*HT; 20 | typedef struct _cx{HT ht;S s;struct _cx *n;}*CX; 21 | typedef struct _v{I a;S s; struct _v *v;CX cx;I t,*l,e,r,o,f,c; 22 | void *attr;I z,p,q;A cd;I rff,rfc,rpf,rpc;A scd,i;}*V; 23 | #define HTSIZE (1<<9) 24 | typedef struct e{I n,f,a[2];}*E; 25 | 26 | #ifdef __cplusplus 27 | 28 | typedef I (*PFI)(); 29 | 30 | extern "C" CX Rx,Cx; 31 | extern "C" int install(PFI f,C *s,I t,I n,I t0,I t1,I t2,I t3,I t4,I t5,I t6,I t7); 32 | extern "C" V vi(S s,CX cx); 33 | extern "C" CX cxi(S s); 34 | extern "C" S si(C *n); 35 | extern "C" CX cx(C *s); 36 | extern "C" A ga(I t;I r,I n,I *d); 37 | extern "C" A gs(I t); 38 | extern "C" A gv(I t,I n); 39 | extern "C" A gm(I t,I r,I c); 40 | extern "C" A gi(I i); 41 | extern "C" A gf(F f); 42 | extern "C" A gsv(I x, C *s); 43 | extern "C" A gn(I n); 44 | extern "C" A gd(I t,A a); 45 | extern "C" A gc(I t,I r,I n,I *d,I *p); 46 | extern "C" int gz( void ); 47 | 48 | extern "C" A grc(A av_, int r_, int c_); 49 | 50 | extern "C" C *qs; 51 | extern "C" C *tst(I t,I *d,I j,I *s,I k,I n); 52 | extern "C" C *tmv(I t,I *d,I *s,I n); 53 | extern "C" C *trp(I t,I d,I s,I n); 54 | extern "C" C *zer(i t,I d,I n); 55 | 56 | extern "C" I ic(A a); 57 | extern "C" I dc(A a); 58 | extern "C" A ci(I i); 59 | extern "C" A ep_cf(I i); 60 | extern "C" A ld1(A a); 61 | extern "C" I ev(I z); 62 | extern "C" I ee(E e); 63 | extern "C" A ez(I); 64 | extern "C" I fa(I f,I a,I w); 65 | extern "C" I *tm(I n); 66 | extern "C" void tf ( void ); 67 | extern "C" I *ma(I n); 68 | extern "C" void mf(I *); 69 | extern "C" I *tr(I r,I *d); 70 | extern "C" I APL,*Y,*X,*K,*J,sq,q,(*g)(); 71 | extern "C" I Df,Gf,Sf,Tf,Xf,Ef; 72 | extern "C" A nl; 73 | extern "C" I aset( V v_, A d_, A i_, A p_ ); 74 | extern "C" A af4( A, A, A, A, A, V ); 75 | extern "C" A gt( V v_ ); 76 | extern "C" A un( A *p ); 77 | 78 | #else 79 | extern CX Rx,Cx; 80 | extern V vi(); 81 | extern CX cxi(), cx(); 82 | extern C *qs,*tst(),*tmv(),*trp(),*zer(); 83 | extern A ci(),ep_cf(),ga(),gv(),gs(),gc(),gd(),gi(),gf(),gm(),ld1(),un(); 84 | extern I gsv(),ev(),ee(),fa(),APL,*Y,*X,*K,*J,sq,q,(*g)(),*tm(),*ma(),tr(),nl; 85 | extern I Df,Gf,Sf,Tf,Xf,Ef; 86 | #endif 87 | 88 | #define T(x) ((x)<<(t+2&3)) 89 | #define Tt(t,x) ((x)<<(t+2&3)) 90 | #define Q(x,n) {if(x)R q=n,0;} 91 | #define W(x) {z=(A)(x);} 92 | #define It 0L 93 | #define Ft 1L 94 | #define Ct 2L 95 | #define Et 4L 96 | #define Xt 8L 97 | #define M 7 98 | #define U(a) ((I)(a)>>3) 99 | #define QA(a) (0==((I)(a)&M)) 100 | #define QV(a) (1==((I)(a)&M)) 101 | #define QS(a) (2==((I)(a)&M)) 102 | #define QE(a) (3==((I)(a)&M)) 103 | #define QN(a) (4==((I)(a)&M)) 104 | #define QL(a) (5==((I)(a)&M)) 105 | #define QP(a) (6==((I)(a)&M)) 106 | #define QX(a) (7==((I)(a)&M)) 107 | #define MV(a) (1|(I)(a)) 108 | #define MS(a) (2|(I)(a)) 109 | #define ME(a) (3|(I)(a)) 110 | #define MN(a) (4|(I)(a)<<3) 111 | #define ML(a) (5|(I)(a)<<3) 112 | #define MP(a) (6|(I)(a)<<3) 113 | #define MX(a) (7|(I)(a)<<3) 114 | #define XS(a) ((S)((I)(a)&~M)) 115 | #define XV(a) ((V)((I)(a)&~M)) 116 | #define XE(a) ((E)((I)(a)&~M)) 117 | 118 | #endif 119 | -------------------------------------------------------------------------------- /a/m.c: -------------------------------------------------------------------------------- 1 | char what_a_m_c[] = "@(#) $Id: m.c,v 1.45 1993/04/23 15:49:28 atw Exp $"; 2 | #include "f.h" 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | 15 | extern void coreLimSet(); 16 | Z qw;Z sigi(){q=1;}Z sigc(){if(qw)wait(0);} 17 | Z sigv(){qs="segv";err(-1,0);}Z sigb(){qs="bus";err(-1,0);} 18 | Z sigf(){q=9;}matherr(){R 1;} 19 | 20 | #if defined(_AIX) || defined(linux) 21 | Z unsigned k1=0X40000000,k2=0x100000; 22 | nan(){} 23 | map(f,i){I junk=0, rc, *p;read(f,&junk,4); 24 | p=(I *)mmap(0,lseek(f,0,SEEK_END),PROT_READ|(1?PROT_WRITE:0),i&27?MAP_PRIVATE:MAP_SHARED,f,0); 25 | if(i)p[0]=junk;close(f);R (I)p;} 26 | #else 27 | Z unsigned k1=0x40000000,k2=0x100000; 28 | nan(){ieee_handler("set","invalid",sigf);/*ieee_handler("set","division",sigf);*/} 29 | map(f,i){I p=(I)mmap(0,lseek(f,0,2),PROT_READ|(i?PROT_WRITE:0),i&2?MAP_PRIVATE:MAP_SHARED,f,0);close(f);R p;} 30 | #endif 31 | 32 | syst(s)C*s;{I r;qw=0,r=system(s),qw=1,r;if(r==-1)H("%ld\n",r);R r;} 33 | Z struct stat b;gwd(s)C *s;{Z C r[99];Z dev_t d;Z ino_t i;stat(".",&b); 34 | if(d!=b.st_dev||i!=b.st_ino)d=b.st_dev,i=b.st_ino,qw=0,getcwd(r,99),qw=1;strcpy(s,r);} 35 | sgi(){coreLimSet(0);/*signal(SIGCHLD,sigc);*/signal(SIGPIPE,SIG_IGN); 36 | signal(SIGINT,sigi);signal(SIGSEGV,sigv);signal(SIGBUS,sigb);nan();} 37 | Z mchk(n,a)A a;{I t=(I)a!=-1&&!a->c&&(t=a->t)<=Ct&&n>=AH+T(a->n); 38 | if(!t)H("not an `a object\n");R t;} 39 | #define MM 2000 40 | typedef struct{I a,c,n,w;}L;Z L mt[MM];Z mm=0;lds(){} 41 | Z L *ml(a){DO(mm,if(mt[i].a==a)R mt+i)R 0;}wr(a){L *p=ml(a);R p?p->w:0;} 42 | im(a){L *p=ml(a);if(p)++p->c;R a;} 43 | dm(a){L *p=ml(a);if(p&&!--p->c)munmap(a,p->n),p->a=0;} 44 | nmap(a,i){L *p=ml(0);I n=lseek(a,0,2);Q(!mchk(n,a=map(a,i)),9) 45 | if(!p){if(mm==MM)R H("maplim\n"),q=9,0;p=mt+mm++;}R p->c=1,p->n=n,p->w=i,p->a=a;} 46 | Z f[9],j,k;Z C z[]="/var/atmp/0/aXXXXXX",c[]="/var/atmp/0"; 47 | 48 | flen(f,n){R ftruncate(f,n);} 49 | Z mkt(b)C *b;{I f=mkstemp(b);unlink(b);strcpy(b+strlen(b)-6,"xxxxxx"); 50 | R fcntl(f,F_SETFD,1|fcntl(f,F_GETFD,0)),f;} 51 | wi(){for(;!access(c,6);z[10]=c[10]='0'+ ++j)f[j]=mkt(z);} 52 | #define mapf(f,o) (I)mmap(k1,k2,PROT_READ|PROT_WRITE,MAP_SHARED|MAP_FIXED,f,0) 53 | Z wsm(m){I p=k1,z=(k+m+j-1)/j*k2;DO(j,flen(f[i],z)) 54 | DO(m,if(-1==mapf(f[k%j],k2*(k/j)))R -1;++k;k1+=k2)R p;} 55 | Z mal(n){I p=(I)malloc(n);if(!p)perr("malloc");R p;} 56 | Z tw;tmp(n){I m,p=j||k?(m=1+(n-1)/k2,n=m*k2,wsm(m)):mal(n); 57 | R tw+=n,p?(mb(p,n>>2),1):0;} 58 | 59 | extern u_long MZ[]; 60 | wa(k){I j,n=0,*p;tm(0);if(k>0)R tmp(k<<20);if(k==-2)mc();p=(I*)mz(); 61 | DO(31,j=p[i];n+=j*MZ[i];if(k!=-1)H("%ld ",j))if(k!=-1)H("n%u %u: ",tw,ep_all());H("%lu\n",n<<2);} 62 | 63 | twGet(){R tw;} 64 | ep_all(){I s=0;if(!j)R tw;DO(j,fstat(f[i],&b);s+=512*b.st_blocks)R s;}/*||*/ 65 | extern C *index(),*getenv(); 66 | 67 | Z int unloadable(s,m) C *s; I m; 68 | { 69 | struct stat ss; 70 | if(access(s,m))R 1; 71 | if(stat(s,&ss))R 1; 72 | if(S_ISDIR(ss.st_mode))R 1; 73 | R 0; 74 | } 75 | 76 | C *pfind(v,d,f,m) C *v,*d,*f; 77 | { 78 | Z C s[MAXPATHLEN]; 79 | if(*f=='/')R unloadable(f,m)?0:f; 80 | for((v&&(v=getenv(v)))?d=v:0;d;) { 81 | if(v=index(d,':'))*s=0,strncat(s,d,v-d),d=v+1; 82 | else strcpy(s,d),d=0; 83 | strcat(s,"/"),strcat(s,f); 84 | if(!unloadable(s,m))R s; 85 | } 86 | R 0; 87 | } 88 | -------------------------------------------------------------------------------- /a/main.c: -------------------------------------------------------------------------------- 1 | /*LINTLIBRARY*/ 2 | char what_atw_a_main_c[]="@(#) $Id: main.c,v 1.3 1992/09/04 16:44:31 dff Exp $"; 3 | #include 4 | #include 5 | #include 6 | extern long strtol(); /* should be declared in a strtol.h */ 7 | extern void pr(); 8 | extern int ai(); 9 | #include 10 | #include "f.h" 11 | extern void versSet(); 12 | extern I Tf; 13 | 14 | /* internal macro declarations */ 15 | #define BANNER "A+" 16 | #define COPYRIGHT \ 17 | "Copyright (C) 1990,1991,1992 Morgan Stanley Group Inc." 18 | #define VERSION "Arthur's" 19 | #define DFLT_ATREE \ 20 | "/usr/local/a+_1" 21 | 22 | /* internal function declaration */ 23 | Z void printId(); 24 | Z I parseargs(); 25 | Z void ignore_dup(); 26 | Z void argvInstall(); 27 | Z void getm(); 28 | 29 | /* internal data declarations */ 30 | Z C *usage; 31 | Z I _load_s; 32 | Z I _workarea; 33 | 34 | /* internal data definitions */ 35 | Z C *usage = "usage: a+ [-s] [-w workarea] [script [scriptargs]]/n"; 36 | Z I _load_s; 37 | Z I _workarea; 38 | Z I m=1; 39 | Z C *_banner = BANNER; 40 | Z C *_copyright = COPYRIGHT; 41 | Z C *_version = (char *)0; 42 | 43 | I main(argc, argv) 44 | I argc; 45 | C **argv; 46 | { 47 | Z C *banner = BANNER; 48 | Z C *copyright = COPYRIGHT; 49 | Z C *version = VERSION; 50 | I i; /* the number of arguments parsed */ 51 | 52 | printId(banner, copyright, version); 53 | i = parseargs(argc, argv); 54 | ai(_workarea); /* initialize */ 55 | versSet(VERSION); 56 | argvInstall(argc, argv, i); /* set up _argv */ 57 | if (i < argc && argv[i] && * argv[i]) 58 | loadafile(argv[i],0); /* load script */ 59 | if (Tf) pr(); /* initial prompt */ 60 | for (;;) getm(); /* main loop */ 61 | } 62 | 63 | Z I parseargs(argc, argv) 64 | register I argc; 65 | register C *argv[]; 66 | { 67 | I isinvalid = 0; 68 | C *optlist = "w:s"; 69 | I wflag = 0, sflag = 0; 70 | I c; 71 | C *ep; /* points to end of option argument */ 72 | C *cp; 73 | 74 | if (argsfirst(argc, argv) != 0) 75 | { 76 | Warn("%t usage: argument list is empty\n"); 77 | isinvalid = 1; 78 | } 79 | 80 | while ((c = argsgetopt(argc, argv, optlist)) != -1) 81 | { 82 | switch (c) 83 | { 84 | case 's': 85 | if (sflag == 0) 86 | { 87 | sflag = 1; 88 | _load_s = 0; 89 | } 90 | else ignore_dup(c); 91 | break; 92 | case 'w': 93 | if (wflag == 0) 94 | { 95 | wflag = 1; 96 | _workarea = (I)strtol(args_value, &ep, 10); 97 | if ((*ep != '\0') || (_workarea < 1)) 98 | { 99 | Warn("%t usage :'%s' is invalid workarea size\n", 100 | args_value); 101 | isinvalid = 1; 102 | } 103 | } 104 | else ignore_dup(c); 105 | break; 106 | default: 107 | Warn("%t usage: -%c is an unknown option\n", c); 108 | isinvalid = 1; 109 | break; 110 | } 111 | } 112 | 113 | /* check for presence of required options */ 114 | 115 | if (isinvalid) 116 | { 117 | Exit(1, usage); 118 | } 119 | 120 | /* set up defaults as necessary */ 121 | if (sflag == 0) _load_s = 1; 122 | if (wflag == 0) _workarea = 4; 123 | 124 | R args_index; 125 | } 126 | 127 | Z void ignore_dup(c) 128 | register I c; 129 | { 130 | Warn("%t usage: duplicate -%c option ignored\n", c); 131 | } 132 | 133 | Z A get(x,s)C *s;{A r=(A)gsv(x,s);r->r=1;R r;} 134 | Z A gst(I x,C* s){A r=(A)gsv(x,s);r->r=1;return r;} 135 | void argvInstall(argc, argv, offset) 136 | I argc; 137 | C **argv; 138 | I offset; 139 | { 140 | A aobj; V v; I i=0; 141 | 142 | if (argc < offset) { argv += argc; argc = 0; } 143 | else { argv += offset; argc -= offset; } 144 | aobj = gv(Et, argc); 145 | while (argc--) aobj->p[i++] = (I)gst(0, *argv++); 146 | v = vi(si("_argv"), Rx); 147 | if (v->a) dc(v->a); 148 | v->a = (I)aobj; v->t=0; 149 | R; 150 | } 151 | 152 | static void printId(void) 153 | { 154 | if (_banner != (char *)(0)) 155 | fprintf(stderr, " %s\n", _banner); 156 | if (_copyright != (char *)(0)) 157 | fprintf(stderr, " %s\n", _copyright); 158 | if (_version != (char *)(0)) 159 | fprintf(stderr, " This version is %s\n", _version); 160 | fflush(stderr); 161 | } 162 | 163 | /* CALL OUTS GOT TO GO */ 164 | void dst(v_)V v_;{} 165 | void xf(){} 166 | void xup(v,d,i,p,r){} /* update variable on screen */ 167 | I vfy(v,a)V v;A a;{R a->n!=7;} 168 | void disable (){m&=~1;} 169 | void enable(){m|=1;} 170 | 171 | /* MAIN LOOP BODY */ 172 | Z void getm(){I n=m; 173 | if(-1==select(32,&n,0,0,0)&&Tf)NL,sbi(),pr();else if (n&1)tf();} 174 | 175 | -------------------------------------------------------------------------------- /a/n.c: -------------------------------------------------------------------------------- 1 | char what_a_n_c[] = "@(#) $Id: n.c,v 1.36 1993/04/24 00:56:56 maus Exp $"; 2 | #include "f.h" 3 | #include "x.h" 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | typedef struct{I u,s,e;}B;Z B t0;Z A ta;Z tn,td[2]={0,4},**tp,tj;Z e0; 10 | Z tvl(t)struct timeval t;{R t.tv_sec*1000+10*(t.tv_usec/10000);} //in source docs, func "tvl" was named "tr" 11 | Z B ti(){Z struct rusage r;Z struct timeval tp;Z struct timezone tzp;B t; 12 | gettimeofday(&tp,&tzp),getrusage(RUSAGE_SELF,&r); 13 | R t.u=tvl(r.ru_utime),t.s=tvl(r.ru_stime),t.e=tvl(tp)-e0,t;} 14 | te(){e0=ti().e;} 15 | Z B tz(x,y)B x,y;{B t;R t.u=x.u-y.u,t.s=x.s-y.s,t.e=x.e-y.e,t;} 16 | Z tw(z,t)B *z,t;{z->u+=t.u,z->s+=t.s,z->e+=t.e;} 17 | t2(n,i){B t;I*p=((A)ta->p[1])->p;if(i)++p[4*n];t0=tz(t=ti(),t0); 18 | R p+=4*tn+1,*p+=t0.u,p[1]+=t0.s,p[2]+=t0.e,t0=t,i=tn,tn=n,i;} 19 | Z gt(t)B t;{A z=gv(It,3);R(*(B*)z->p)=t,(I)z;} 20 | Z H1(t1){I n=a->n;A z;if(tj){DO(tj,if(tp[i])*tp[i]=0)dc(ta),ta=0;} 21 | if(tj=n){extern V sv();V v;*td=++n,z=(A)zr(ga(It,2,n*4+tj,td)); 22 | tp=(I**)z->p+(z->n=n*4);ta=gv(Et,2),*ta->p=ic(a),ta->p[1]=(I)z; 23 | DO(tj,if(v=sv(Cx,XS(a->p[i])),z=(A)(v->e?v->e:v->a))*(tp[i]=z->p+z->n)=i+1)} 24 | R t0=ti(),ic(a);} 25 | 26 | #define N(f) Z f(e)E e; 27 | Z ni(a)A a;{I i;for(*--Y=(I)a;a->n!=1||a->t&&!(a=ci(0));a=(A)*Y)err(9,MN(*K));R i=*a->p,dc(*Y++),i;} 28 | N(xpr){I z=nl,n=e->n;++K;DO(n,*K=010i;dc(z);z=ev(e->a[i]))R --K,z;} 29 | N(xif){I z;*++K=2;z=ni(ev(*e->a))?ev(e->a[1]):e->n>2?(*K=1,ev(e->a[2])):nl;R --K,z;} 30 | N(xwh){I z;*++K=3;for(*--Y=z=nl;ni(ev(*e->a));*Y=ev(e->a[1]),dc(z),z=*Y);R --K,++Y,z;} 31 | Z set(a,i)A *a;{if((*a)->c!=1||(*a)->t!=It||(*a)->n)dc(*a),*a=gi(i);else *(*a)->p=i;} 32 | N(xdo){I v=*e->a,i,z=nl,f=1;A *a;if(e->n==1)R pev(v); 33 | {E e;if(QE(v)&&(e=XE(v),e->f==MP(15)&&e->n==1))v=*e->a,f=0;} 34 | i=ni(ev(v));*++K=4;if(QE(v)&&MN(0)==XE(v)->f)v=*XE(v)->a; 35 | if(a=(A*)(QV(v)?&XV(v)->a:QL(v)?X+U(v):0))set(a,f?0:i-1); 36 | for(v=0;va[1]),++v,a)set(a,f?v:i-1-v);if(!f)set(a,i);R --K,z;} 37 | Z H2(in){I n=a->r?*a->d:1;for(*--Y=ic(w),*--Y=(I)a;a=(A)fnd(*Y,Y[1]),q;)err(q,MP(19)); 38 | dc(*Y++),dc(*Y++),dc(a);DO(a->n,if(n>a->p[i])R 1)R 0;} 39 | N(xca){I *p,z;*++K=5,z=ev(*e->a),e=XE(e->a[1]),p=e->a;++K; 40 | DO(e->n/2,*K=-1-2*i;if(in(ev(*p++),z))break;++p)R --*K,dc(z),z=pa+e->n?ev(*p):nl,K-=2,z;} 41 | N(xti){B t;A a;if(!e->n)R ta?(t2(0,0),ic(ta)):gt(ti());a=(A)*e->a; 42 | R QA(a)&&sym(a)||nl==(I)a?t1(a):(t=ti(),dc(ev(a)),gt(tz(ti(),t)));} 43 | N(xli){A z;I n=e->n;W(gv(Et,n));*--Y=zr(z);for(;n--;)z->p[n]=ev(e->a[n]);R ++Y,(I)z;} 44 | 45 | Z mx(o,f,g){A z;I d[3];*d=MN(o),d[1]=f,d[2]=g;R(I)ga(Xt,g?3:2,0L,d);} 46 | N(rk){R mx(8,ev(*e->a),ev(e->a[1]));} 47 | N(ea){A a=(A)ev(*e->a);if(QF(a))R mx(9,a,0L); 48 | R a->n==1&&a->t==Et&&QF(*a->p)&&QS(*a->p)?(dc(a),ic(*a->p)):(I)a;} 49 | extern xis();I(*PN[])()={xis,xpr,xif,xwh,xdo,xca,xti,xli,rk,ea}; 50 | #define XI 10000 51 | C *xs[XI]={"[]"},*xd[XI]={"??"};I xn[XI]; 52 | Z I(*xf[XI])(),xt[XI],xp[XI],xi=0,y[8]; 53 | Z C *argtypes[]={"any","int","float","char","any","int","float","string", 54 | "anyscalar","scalar int","floatsc","charsc","any","int","float","char"}; 55 | 56 | Z C *cxtdotname(v) V v;{ C *res, *cxt=v->cx->s->n, *name=v->s->n; 57 | res=malloc(2+strlen(cxt)+strlen(name));sprintf(res,"%s.%s",cxt,name);R res;} 58 | 59 | Z C *defaultdoc(s,t,n,y)C *s;I *y;{ C *z=malloc(128+strlen(s)); 60 | strcpy(z,s); 61 | if(n) { 62 | strcat(z,"{"); 63 | while(n--){strcat(z,argtypes[*y++]);strcat(z,";");} 64 | z[strlen(z)-1]='}'; 65 | } else strcat(z,"{}"); 66 | strcat(z," returns ");strcat(z,(8==t)?"null":argtypes[t]);R z; 67 | } 68 | 69 | Z C *installdoc(s,d)C *s,*d;{C *z=malloc(2+strlen(s)+strlen(d)); 70 | strcpy(z,s);strcat(z,"\n");strcat(z,d);R z;} 71 | 72 | xfs(){C **s=xs;for(;*++s;)if(**s=='_'&(*s)[1]!='_')H("%s ",*s);NL;} 73 | x_fs(){C **s=xs;for(;*++s;)if(**s==')'&&(*s)[1]=='_')H("$s ",*s);NL;} 74 | 75 | xinstall(f,s,t,n,y,d)I(*f)(),*y;C *s,*d;{I p=0,i;V v;C *nm=0; 76 | if(xi==XI-1)R H("too many installs\n"),0; 77 | xf[++xi]=f,xt[xi]=t,xn[xi]=n;if(*y==-1)R xp[xi]=-1; 78 | if(n<0)n= -n;if(n>8)R --xi,H("too many arguments for %s\n",s),0; 79 | for(i=n;i-->0;)p|=y[i]<<4*i;xp[xi]=p; 80 | if(*s!='_'){extern V sv();v=sv(Cx,si(s)),v->a=MX(xi),v->t=5,nm=cxtdotname(v);} 81 | if (d==(C *)0) d=defaultdoc(nm?nm:s,t,n,y); else d=installdoc(nm?nm:s,d); 82 | xs[xi]=(nm?nm:s);xd[xi]=d?d:""; R 1;} 83 | 84 | install(f,s,t,n,t0,t1,t2,t3,t4,t5,t6,t7)I(*f)();C *s;{ 85 | y[0]=t0,y[1]=t1,y[2]=t2,y[3]=t3,y[4]=t4,y[5]=t5,y[6]=t6,y[7]=t7; 86 | xinstall(f,s,t,n,y,(C *)0);} 87 | #define RA(x) R z=(*f)x,!z&&q?0:t==A_?(z?z:nl):t==CP?gsv(0,z):t==IV?(I)gi(z):nl 88 | PX(i,n){I t=xt[i],p=xp[i],(*f)()=xf[i],z;A a; 89 | Q(n!=xn[i]&&xn[i]>=0,5);if(p==-1)RA((Y,n));for(i=0;i>=4,z&3){ 91 | CS(CA,Q(Ct!=a->t,6)) 92 | CS(IA,if(It!=a->t&&!(a=ci(i)))R 0) 93 | CS(FA,if(Ft!=a->t&&!(a=ep_cf(i)))R 0)} 94 | switch(z&12){case U_:a=(A)un(Y+i); 95 | CS(A_,y[i]=(I)a) 96 | CS(P_,y[i]=(I)a->p) 97 | CS(V_,Q(a->n!=1,8)y[i]=*a->p)}} 98 | switch(n){ 99 | CS(0,RA(())) 100 | CS(1,RA((y[0]))) 101 | CS(2,RA((y[0],y[1]))) 102 | CS(3,RA((y[0],y[1],y[2]))) 103 | CS(4,RA((y[0],y[1],y[2],y[3]))) 104 | CS(5,RA((y[0],y[1],y[2],y[3],y[4]))) 105 | CS(6,RA((y[0],y[1],y[2],y[3],y[4],y[5]))) 106 | CS(7,RA((y[0],y[1],y[2],y[3],y[4],y[5],y[6]))) 107 | CS(8,RA((y[0],y[1],y[2],y[3],y[4],y[5],y[6],y[7]))) 108 | }} 109 | -------------------------------------------------------------------------------- /a/o.c: -------------------------------------------------------------------------------- 1 | char what_a_o_c[] = "@(#) $Id: o.c,v 1.27 1993/02/19 17:27:37 atw Exp $"; 2 | #include "f.h" 3 | extern I rsh(A,I,I *); 4 | Z dp(a)A a;{I k,d=0;if(QF(a))R -1;if(a->tn,if((k=1+dp(a->p[i]))>d)d=k)R d;} 5 | Z C *i2f(t,d,s,n)F *d;I *s;{DO(n,*d++=*s++)R(C*)d;} 6 | Z dr(a,f)A a;I f;{XA;A z,*ap=(A*)a->p,w;if(!an||at!=Et||fsy(a))R ic(a); 7 | w=*ap; Q(QF(w),9)if(!ar)R ic(w);{XW;I i=an,n,t;C *p; 8 | if(f){Q(ar>1,7)V0 n=*wd;}else{Q(ar+wr>MAXR,13)mv(ad+ar,wd,wr);} 9 | for(;--i;){Q(!QA(a=ap[i])||(t=a->t)>Et,9)if(wt!=t&&a->n)if(f&&!n)wt=t;else{Q(wt>Ft||t>Ft,6)wt=Ft;} 10 | if(wr!=a->r){Q(!f||wr>1||a->r,7)*a->d=1;}Q(cm(wd+f,a->d+f,wr-f),11)if(f)n+=*a->d;} 11 | W(ga(wt,f?wr:ar+wr,f?n*tr(wr-1,wd+1):an*wn,f?wd:ad))if(f)*z->d=n;p=(C*)z->p; 12 | DO(an,a=ap[i];p=(*(a->t==wt?tmv:i2f))(wt,p,a->p,a->n))R(I)z;}} 13 | H1(dis){R dr(a,0);}H1(raz){R dr(a,1);}H1(dep){R(I)gi(dp(a));} Z t,v; 14 | H2(pen){A z,*p;I1{XW;I t=wt,d[9],*ap=a->p,an=a->n,j=an==1?*ap:0,k=*wd,n;C *wp=(C*)w->p;Q(!wr,7) 15 | DO(an,Q(ap[i]<0,9)) 16 | n=tr(wr-1,wd+1);mv(d+1,wd+1,wr-1);if(j&&k!=(an=k/j)*j)++an;W(j?gv(Et,an):gd(Et,a))*--Y=zr(z),p=(A*)z->p; 17 | for(;an--;wp+=T(wn),k-=*d)*p++=gc(wt,wr,wn=n*(*d=j?j:*ap++,*d=*d>k?k:*d),d,wp);R ++Y,(I)z;}} 18 | G0(C,lag){C *p=r+T(n);I j=T(v),k=v*-*a;for(;rp,k=*w->d,r=w->r;if(!r)R j==1?rsh(w,1,a->p):(q=7,0); 20 | mv(d+2,w->d+1,r-1);if(j>0){d[1]=j,*d=k/j;Q(k!=*d*j,8)R rsh(w,r+1,d);} 21 | d[1]=-j,*d=k+j+1;Q(*d<0,8)W(ga(t=w->t,r+1,*d*d[1]*(v=tr(r-1,d+2)),d))C2(lag)}} 22 | H1(pct){A z;I i=0,j=0,k=0,n=a->n,*p;I1 W(a->c==1?(A)ic(a):gv(It,n)) 23 | if(n){Q(a->r>1,7)Q(!*a->p,9)for(p=z->p;++ip[i])p[j++]=i-k,k=i;p[j++]=n-k;z->n=*z->d=j;}R(I)z;} 25 | 26 | Z gC(t,r,n,d,p){A z=ga(t,r,n,d);p?tmv(t,z->p,p,n):zer(t,z->p,n);R(I)z;} 27 | Z I raw(r,i)I r,i;{R i<0?(-i>r?r:-i):i>r?0:r-i;} 28 | I rk(f,r,a,w)I f; A r,a,w;{A z,*p;XA;C *pp,*ap,*wp;I wt,wr,wn,*wd,n,t,i,j,k,d[9],rw,ra, 29 | ri,ir,iw,ia,ii,e=!w&&f==MP(9),h=QP(f)&&!e;Q(!QA(r),9) 30 | if(!w)mv(d,ad,r),ir=tr(ra,ad),ad+=ra; 31 | else{wt=w->t,wr=w->r,wd=w->d;wr-=rw=raw(wr,r->p[r->n>1]), 32 | ri=r->n>2?r->p[2]:9;Q(ri<0,9)if(ri>ra)ri=ra;if(ri>rw)ri=rw;mv(d,ad,ra-=ri); 33 | ia=tr(ra,ad),mv(d+ra,wd,rw),iw=tr(rw-=ri,wd);Q(cm(ad+=ra,wd+=rw,ri),11) 34 | ii=tr(ri,ad),ra+=rw+ri,ir=ia*iw*ii,wn=tr(wr,wd+=ri),ad+=ri; 35 | if(h&&ir>iw&&(f==MP(21)||f==MP(25)||f==MP(26)||f==MP(32)||f==MP(33)))h=0;} 36 | an=tr(ar,ad); 37 | if(h){g=0;if(!(r=(A)fa(f,gC(at,ar,an,ad,a->n?a->p:0),w?gC(wt,wr,wn,wd,w->n?w->p:0):0)))R 0; 38 | mv(d+ra,r->d,j=r->r);if((j+=ra)>MAXR)R q=13,(I)r;n=r->n;t=r->t; 39 | if(ir<2)R mv(r->d,d,r->r=j),r->n*=ir,(I)r;dc(r);if(g==rsh)R rsh(w?w:a,j,d); 40 | if(!g){h=0;goto L;}if(at=((A)Y[w?-2:-1])->t,w)wt=((A)Y[-1])->t; 41 | if(at!=a->t&&!(a=at?ep_cf(1):ci(1)))R 0;if(w&&wt!=w->t&&!(w=wt?ep_cf(2):ci(2)))R 0; 42 | OF(i,ir,n)W(ga(t,j,i,d))pp=(C*)z->p;} 43 | else{L:W(ga(Et,ra,ir,d))*--Y=zr(z),p=(A*)z->p;} 44 | if(!w)for(ap=(C*)a->p;ir--;ap+=Tt(at,an)) 45 | if(h)(*g)(pp,ap,an),pp+=T(n);else a=gc(at,ar,an,ad,ap),*p++=e?a:(A)fa(f,a,0); 46 | else for(i=0;ip+Tt(at,(i*ii+k)*an);wp=(C*)w->p+Tt(wt,(j*ii+k)*wn); 48 | if(h){(*g)(pp,ap,wp,n),pp+=T(n);if(q==1)*--Y=(I)z,err(q,Y[1]),++Y;} 49 | else *p++=(A)fa(f,gc(at,ar,an,ad,ap),gc(wt,wr,wn,wd,wp));} 50 | if(h)R(I)z;if(!e)z=(A)dis(r=z),dc(r);R ++Y,(I)z;} 51 | 52 | ea(f,a,w)A a,w;{A z,*p;I at=a->t,k=a->r?Tt(at,1):0,wt,j=0;C *ap=(C*)a->p,*wp; 53 | if(w)if(wt=w->t,wp=(C*)w->p,j=w->r?Tt(wt,1):0,k&&j){Q(a->r!=w->r,7) 54 | Q(cm(a->d,w->d,a->r),8)} W(gd(Et,j?w:a))*--Y=zr(z),p=(A*)z->p; 55 | DO(z->n,if(at 4 | #include 5 | #include "s.h" 6 | #include "fir.h" 7 | #undef min 8 | #undef max 9 | #define iszero(x) (x==0.0) 10 | 11 | #define PC putchar 12 | Z C *ns[]={":=","else","if","while","do","case","time","","@","each",0}; 13 | Z C *ps[]={"&","?","+","*","max","min","-","%","|","<", 14 | ">","=","~=","<=",">=","^","log","rand","flip","iota", 15 | "*","rho",",","~","rot","take","drop","upg","dng","==", 16 | "pack","unpack","/","\\","in","bag","pick","mdiv","!","pi", 17 | "&\\","?\\","+\\","*\\","max\\","min\\","&/","?/","+/","*/", 18 | "max/","min/", "+.","*.","max.","min.","-.","%.","|.","<.", 19 | ">.","=.","~=.","<=.",">=.", "^.","+.*","beam","max.+","min.+", 20 | "form","eval","where","of","ref","dot",0}; 21 | Z C *n0[]={"\373","else","if","while","do","case","time","","@","\241",0}; 22 | Z C *p0[]={"^","\251","+","\253","\323","\304","-","\337","|","<", 23 | ">","=","\250","\244","\246","*","\360","?","\364","\311", 24 | "#","\322",",","~","\367","\331","\325","\350","\347","\275", 25 | "^\\","\251\\","+\\","\253\\","\323\\","\304\\","^/","\251/","+/","\259/", 26 | "\323/","\304/","\312.+","\312.\253","\312.\323","\312.\304","\312.-","\312.\337","312.|","\312.<", 27 | "\312.>","312.=","\312.\250","\312.\244","\312.\246","\312.*","+.\253","\350","\323.+","\304.+", 28 | "\356","\342","\335","\333","%","\326",0}; 29 | extern C *xs[],*xd[],*index(),*nx(),*cl(); 30 | lu(s,t)C *s,*t[];{I i=0;for(;t[i];)if(!strcmp(s,t[i++]))R i;R 0;} 31 | Z C*pp(a){R QS(a)?XS(a)->n:(QN(a)?(APL?n0:ns):QP(a)?(APL?p0:ps):xs)[U(a)];} 32 | Z C*ppd(a){R QS(a)?XS(a)->n:(QN(a)?(APL?n0:ns):QP(a)?(APL?p0:ps):xd)[U(a)];} 33 | pi(s)C *s;{I i;if(i=lu(s,APL?n0:ns))R MN(i-1);if(i=lu(s,APL?p0:ps))R MP(i-1); 34 | if(*s=='_')if(i=lu(s,xs))R MX(i-1);R 0;} 35 | Z C*fn(s,n)C *s;{for(;--n;)s=1+nx(s);R s;} 36 | Z C*ss(q,s)C *q,*s;{I n=strlen(s);for(;strncmp(q,s,n);)++q;R q;} 37 | Z C*sb(q)C *q;{I i=0;C c;for(;c=*q++,i||c!='{';)i+=(c=='(')-(c==')');R q;} 38 | sik(){I *p=K,s;for(;*p;--p);for(++p;p<=K;)if(QV(s=*p++))H("%ld[ %ld]\n",s&~M,-*p++); 39 | else{C c,*t,*q,*r;if(QS(s))q=(C*)(s&~M);else{A f=(A)s;q=1+index(f->p[f->n+1],':'); 40 | H("%s.%s: ",((CX)f->p[f->n+2])->s->n,XS(*f->d)->n);} 41 | for(;p<=K&&*p>-9999&*p<6;++p,s=0) 42 | q=cl(0>*p?fn(QS(s)&&*q!='{'?q:sb(q),-*p):ss(q,ns[*p])); 43 | t=nx(q);r=index(q,'\n');if(r&&r-999?H("%ld ",-s):s>0&&s<6?H("%s ",n0[s]):(i?H("]\n"):0,i=!QS(s), 47 | H(i?"%s[":"%s\n",!i||QV(s)?(C*)(s&~M):XS(*((A)s)->d)->n));if(i)H("]\n");} 48 | 49 | #define BRK {if(q==1)R 0;} 50 | Z u;Z in(){NL;DO(2*u,PC(' '))} 51 | pv(v)V v;{H(" %s",v->s->n);} 52 | 53 | pa(v)V v;{paf(v,0);} 54 | 55 | Z C b[30];C Fs[]=" %.10g"; 56 | Z bd(){I i=0;for(;b[i]&&b[i]!='.'&&b[i]!='e';++i);R i;} 57 | Z h(s)C *s;{if(APL&&b[1]=='-')b[1]='\242';strncpy(s,b,strlen(b));} 58 | 59 | Z C *iin[]={""," INf"," -Inf"," Na", " 0"}; 60 | Z inf(x)F x;{R /*x==-999999999?3:*/iszero(x)?4:finite(x)?0:isnan(x)?3:x>0?1:2;} 61 | Z mfmt(b,s,x)C *b,*s;F x;{I i=inf(x);R i?strlen(strcpy(b,iin[i])):SH(x);} 62 | Z dfmt(b,s,m,n,x)C *b,*s;F x;{I k,l,j=inf(x);if(!j)R(I)sprintf(b,s,m,n,x); 63 | if(4==j)R(I)sprintf(b,s,m,n,0.0); 64 | k=strlen(iin[j]);l=' '==*s;DO(m+l,b[i]=' ')strncpy(' '==*s?b:b+m-k,iin[j],k);} 65 | 66 | A mj(a)A a;{P p;I m=0,j=a->t?2:1,l,k;C *s=a->t?Fs:" %d";p.i=a->p;DO(a->n,if(!a->t)k=SH(p.i[i]); 67 | else{l=mfmt(b,s,p.f[i]);k=l-bd();if(k>j)j=k<10?k:10;k=l-k;}if(k>m)m=k)R m+=3+--j,gf((F)m+(F)j/10);} 68 | 69 | H1(mth){A z;XA;P p;C *s=at?Fs:" %d",*d;I j=0,k,m=0,n,l;if(at==Ct)R ic(a); 70 | if(at==Et){Q(ar||(a=(A)*a->p,!QF(a)),6)R gsv(0,!QA(a)?pp(a):a->t==Xt?"*derived*":(C*)a->p[a->n+1]);} 71 | p.i=a->p;n=ar?ad[--ar]:1; 72 | if(ar)DO(an,BRK if(at){l=mfmt(b,s,p.f[i]);k=bd();if(k>j)j=k;k=l-k;} 73 | else k=SH(p.i[i]);if(k>m)m=k) 74 | else DO(an,BRK m+=at?mfmt(b,s,p.f[i]):SH(p.i[i])) 75 | m+=j;W(ga(Ct,ar+1,ar?an*m:m,ad))z->d[ar]=ar?m*n:m;zr(z);d=(C*)z->p; 76 | if(ar)DO(an,at?(mfmt(b,s,*p.f++),h(d+j-bd())):h(d+m-SH(*p.i++));d+=m) 77 | else DO(an,k=at?mfmt(b,s,*p.f++):SH(*p.i++);h(d);d+=k) R(I)z;} 78 | 79 | paf(a,f)A a;{I t;CX cx;BRK switch(M&(I)a){ 80 | case 4:if(U(a)>9)goto L;case 2:case 6:CS(7,H(" %s",(f)?ppd(a):pp(a))) 81 | CS(1,L:cx=XV(a)->cx;if(Cx==cx)pv(XV(a));else{if(cx!=Rx)pv(cx);H(".%s",XV(a)->s->n);}) 82 | CS(3,paf(XE(a)->f,f);H("... ")) 83 | CS(5,t=U(a);(a=(A)*X)&&t>-a->n&&tr?paf(t<0?a->p[-t]:a->d[t],f):H(" &")) 84 | case 0: if(!a)R;t=a->t; 85 | if(t>Et)R H("%s",t>Xt?(u?XS(*a->d)->n:(C*)a->p[a->n+1]):"*derived fn*"); 86 | {I an=a->n,r=a->r,j=t==Et,n,k,d[9],*p;C *s; 87 | if(!an)R;if(!j){if(t!=Ct)dc(a=(A)mth(a));if(q)R 0;s=(C*)a->p,an=a->n,r=a->r;} 88 | else{p=a->p;if(r<2&&sym(a)){DO(an,H(" `%s",XS(*p++)->n))R;}} 89 | if(r>1)for(mv(d,a->d,r),n=d[k=r-1];--k;)d[k]*=d[k+1];else n=r?an:1; 90 | for(;;){if(j)DO(n,H("< ");++u;paf(*p++,f);--u;if(in)in()) 91 | else DO(n,BRK PC(*s++)) 92 | if(!(an-=n))R;for(k=r;--k&&!(an%d[k]);)in();}}}} 93 | 94 | H2(dth){A z;if(sym(w))F1 else F2{Z f[99],g[99],h[99];XW;I n=a->n,u,v,j=0,k=n!=1,*r; 95 | F x,*p=(F*)a->p;C *s;if(!wr)u=v=wr=1;else u=tr(wr-1,wd),v=wd[wr-1];Q(n!=v&&k,8) 96 | Q(n>99,12)DO(n,x=p[i];if(f[i]=x<0)x=-x;j+=g[i]=x;h[i]=.5+10*(x-g[i]);) 97 | W(ga(Ct,wr,u*(j=k?j:j*v),wd))z->d[wr-1]=j,s=(C*)z->p;for(p=(F*)(r=w->p);u--;)DO(v, 98 | if(j=k?i:0,wt==Et)sprintf(s,f[j]?" %-*s":"%*s",g[j]-f[j],XS(*r++)->n); 99 | else dfmt(s,f[j]?" %- *.*e":"%*.*f",g[j]-f[j],h[j],*p++);s+=g[j])R(I)z;}} 100 | -------------------------------------------------------------------------------- /a/q.c: -------------------------------------------------------------------------------- 1 | /* 2 | $cd /u/orth/domino 3 | 4 | cc -c domino.c -o domino.o 5 | 6 | $load domino_a 7 | 8 | $load domino_s 9 | 10 | 'domino.o' _dyld ('_dmd' ;'dmd' ;0 0 0; 11 | '_mmd' ;'mmd' ; 0 0) 12 | 13 | */ 14 | 15 | #include 16 | #include 17 | #include 18 | #include "k.h" 19 | 20 | extern I q; 21 | extern C *qs; 22 | 23 | #define Ma(i,j) *((F *)a->p+n*i+j) 24 | #define Mb(t,i,j) *((t *)b->p+p*i+j) 25 | #define Mh(i,j) *((F *)h->p+2*i+j) 26 | #define Mz(i,j) *((F *)z->p+p*i+j) 27 | 28 | #define vector(t,a,k) *((t *)a->p+k) 29 | #define Vc(k) *((F *)c->p+k) 30 | #define Vfactor(k) *((F *)factor->p+k) 31 | #define Vtvec(k) *((F *)tvec->p+k) 32 | 33 | #define index(n,k) *((I *)n->p+k) 34 | #define Ipp(k) *((I *)pp->p+k) 35 | #define Ipq(k) *((I *)pq->p+k) 36 | 37 | #define DOMAIN_ERROR 9 38 | #define LENGTH_ERROR 8 39 | #define RANK_ERROR 7 40 | 41 | /* 42 | For text errors indicating where an error message originates from, use: 43 | 44 | #define DOMAIN_ERROR -1 45 | #define LENGTH_ERROR -1 46 | #define RANK_ERROR -1 47 | */ 48 | 49 | A dmd(), mmd(); 50 | static A ls_c(); 51 | 52 | /* 53 | ------------ The dyadic case. 54 | */ 55 | 56 | A dmd(b,a) 57 | A b, a; 58 | { 59 | int result_rank; 60 | int m, n, p; 61 | A z; 62 | 63 | if ( (It != a->t && Ft != a->t) || (It !=b->t && Ft != b->t) ) { 64 | qs = "error no. 1"; 65 | q = DOMAIN_ERROR; 66 | return(0); 67 | } 68 | 69 | if (2 < a->r || 2 < b->r ) { 70 | qs = "error no. 2"; 71 | q = RANK_ERROR; 72 | return(0); 73 | } 74 | 75 | if ( 0 == a->r ) result_rank = 0; 76 | else result_rank = a->r - 1; 77 | if ( 0 != b->r ) result_rank += b->r - 1; 78 | 79 | if (2 == a->r ) { 80 | m = a->d[0]; n= a->d[1]; 81 | } 82 | else { 83 | n = 1; 84 | if ( 1 == a->r ) { 85 | m = a->d[0]; 86 | } 87 | else { 88 | m = 1; 89 | } 90 | } 91 | 92 | if ( m < n ) { 93 | qs = "error no. 3"; 94 | q = DOMAIN_ERROR; 95 | return(0); 96 | } 97 | 98 | if ( 2 == b->r ) { 99 | if ( m != b->d[0] ) { 100 | qs = "error no. 4"; 101 | q = LENGTH_ERROR; 102 | return(0); 103 | } 104 | p = b->d[1]; 105 | } 106 | else { 107 | p = 1; 108 | if ( ( 1 == b->r && m != b->d[0] ) || ( 0 == b->r && m != 1 ) ) { 109 | qs = "error no. 5"; 110 | q = LENGTH_ERROR; 111 | return(0); 112 | } 113 | } 114 | 115 | z = ls_c(a,b,m,n,p,0); 116 | 117 | if ( 0 == z ) return(0); 118 | 119 | z->r = result_rank; 120 | if ( 1 <= result_rank ) z->d[0] = n; 121 | if ( 2 == result_rank ) z->d[1] = p; 122 | 123 | return(z); 124 | } 125 | 126 | /* 127 | ------------ The monadic case. 128 | */ 129 | 130 | A mmd( a ) 131 | A a; 132 | { 133 | int result_rank; 134 | int m, n, p; 135 | A z; 136 | 137 | if ( It != a->t && Ft != a->t ) { 138 | qs = "error no. 6"; 139 | q = DOMAIN_ERROR; 140 | return(0); 141 | } 142 | 143 | if (2 < a->r ) { 144 | qs = "error no. 7"; 145 | q = RANK_ERROR; 146 | return(0); 147 | } 148 | 149 | result_rank = a->r; 150 | 151 | if ( 2 == a->r ) { 152 | m = a->d[0]; 153 | n = a->d[1]; 154 | } 155 | else if ( 1 == a->r ) { 156 | m = a->d[0]; 157 | n = 1; 158 | } 159 | else { 160 | m = 1; 161 | n = 1; 162 | } 163 | 164 | if ( m < n ) { 165 | qs = "error no. 8"; 166 | q = DOMAIN_ERROR; 167 | return(0); 168 | } 169 | 170 | p = m; 171 | 172 | z = ls_c(a,0,m,n,p,1); 173 | 174 | if ( 0 == z ) return(0); 175 | 176 | z->r = result_rank; 177 | if ( 1 <= result_rank ) z->d[0] = n; 178 | if ( 2 == result_rank ) z->d[1] = p; 179 | 180 | return(z); 181 | } 182 | 183 | /* ------------ The least squares computation. 184 | Here's the beef. This program is an amalgamation of two of Mike Jenkin's 185 | models for Domino: one is the primitive that appeared in APLSV and VSAPL, 186 | while the other is for the generalized inverse version 187 | that appeared in the original APL2. This program reflect the current state 188 | of Domino in APL2 (as of 7/12/91), except that the complex arithmetic sections 189 | are missing. 190 | */ 191 | 192 | static A ls_c(a0,b,m,n,p,monadic) 193 | A a0, b; 194 | int m, n, p, monadic; 195 | /* 196 | m,n,p : scalars set by the driver 197 | a0 : the right argument, a matrix of shape m,n 198 | b : the left argument in the dyadic case, a matrix of shape m,p 199 | z : the result, a matrix of shape n,p 200 | monadic : a flag used to signal generation fo the identity matrix 201 | */ 202 | { 203 | I i,j, i0, j0, d[MAXR], l, pi, pj; 204 | F eps, mv, mmv, s, sa, st, t, tolerance, t0, t1, t2, t3, t4, t5, v; 205 | A a, c, factor, h, pp, pq, tvec, z; 206 | /* 207 | Make a copy of a0 because it will be modified. Remember that a0 can be 208 | either integer of real, and always copy to real. 209 | */ 210 | a = ga(Ft, a0->r, a0->n, a0->d ); 211 | 212 | switch( a0->t ) { 213 | case It: 214 | for ( i = 0; i < a0->n; ++i ) 215 | vector(F,a,i) = vector(I,a0,i); 216 | break; 217 | case Ft: 218 | for ( i = 0 ; i < a0->n ; ++i ) 219 | vector(F,a,i) = vector(F,a0,i); 220 | break; 221 | }; 222 | /* 223 | Initialize the temps and the result. 224 | */ 225 | d[0] = m; 226 | pq = ga(It, 1, d[0], d ); 227 | for ( i = 0 ; i < m ; ++i ) Ipq(i) = i; 228 | 229 | c = ga(Ft, 1, d[0], d ); 230 | 231 | d[0] = n; 232 | pp = ga(It, 1, d[0], d ); 233 | for ( i = 0 ; i < n ; ++i ) Ipp(i) = i; 234 | 235 | factor = ga(Ft, 1, d[0], d ); 236 | 237 | d[1] = 2; 238 | h = ga(Ft, 2, d[0]*d[1], d ); 239 | 240 | d[1] = p; 241 | z = ga(Ft, 2, d[0]*d[1], d ); 242 | 243 | if ( n <= m ) d[0] = m; 244 | tvec = ga(Ft, 1, d[0], d ); 245 | /* 246 | tolerance : APL uses 1e-16. Jenkin's original paper uses 16e-13. 247 | */ 248 | mmv=0.; 249 | for ( i = 0 ; i < m ; ++i ) { 250 | t0 = 0.0; 251 | for ( j = 0 ; j < n ; ++j ) { 252 | sa = Ma(i,j); 253 | if ( 0 > sa ) sa = - sa; 254 | t0 = t0 + sa; 255 | } 256 | if ( mmv < t0 ) mmv = t0; 257 | } 258 | tolerance = 1e-16; 259 | eps = tolerance*mmv; 260 | /* 261 | Here is the scaling from the APLSV/VSAPL model: 262 | */ 263 | for ( i = 0 ; i < m ; ++i ) { 264 | Vtvec(i)=0.0; 265 | for ( j = 0 ; j < n ; ++j ) { 266 | t1 = Ma(i,j); 267 | if ( 0 > t1 ) t1 = -t1; 268 | if ( Vtvec(i) sa ) sa = -sa; 277 | t2 = sa / Vtvec(i); 278 | if ( Vfactor(j) t3 ) t3 = -t3; 304 | if ( mv < t3 ) { 305 | mv = t3; 306 | } 307 | } 308 | 309 | if ( mmv < mv ) { 310 | mmv = mv; 311 | pj = j0; 312 | } 313 | } 314 | if( eps >= mmv ) { 315 | qs = "error no. 9"; 316 | q = DOMAIN_ERROR; /* There is no rank deficient case. */ 317 | dc(a); dc(c); dc(factor); dc(h); dc(pp); dc(pq); dc(tvec); dc(z); 318 | return(0); 319 | } 320 | if ( j != pj ) { 321 | i = Ipp(pj); 322 | Ipp(pj) = Ipp(j); 323 | Ipp(j) = i; 324 | 325 | for ( i = 0 ; i < m ; ++i ) { 326 | s = Ma(i,pj); 327 | Ma(i,pj) = Ma(i,j); 328 | Ma(i,j) = s; 329 | } 330 | } 331 | /* 332 | The followint row interchange is from the APLSV/VSAPL model. 333 | */ 334 | t = 0.0; 335 | pi = 0; 336 | for ( i0 = j; i0 < m ; ++i0 ) { 337 | t4 = Ma(i0,j); 338 | if ( 0 > t4 ) t4 = -t4; 339 | if ( t < t4 ) { 340 | t = t4; 341 | pi = i0; 342 | } 343 | } 344 | if ( j != pi ) { 345 | 346 | Ipq(j) = Ipq(pi); 347 | 348 | for ( j0 = j ; j < n ; ++j0 ) { 349 | s = Ma(j,j0); 350 | Ma(j,j0) = Ma(pi,j0); 351 | Ma(pi,j0) = s; 352 | } 353 | } 354 | /* 355 | Now do the i-th transformation (in place). 356 | */ 357 | t = 0.0; 358 | for ( i0 = j ; i0 < m ; ++i0 ) { 359 | t5 = Ma(i0,j); 360 | if ( 0 > t5 ) t5 = -t5; 361 | } 362 | v = 0.0; 363 | for ( i0 = j ; i0 < m ; ++i0 ) { 364 | s = Ma(i0,j) / t; 365 | v = v + s*s; 366 | } 367 | v = t*sqrt(v); 368 | if ( Ma(j,j) < 0 ) v = -v; 369 | /* 370 | Save the essential values and ajust the kiagonal element. 371 | */ 372 | Mh(j,0) = v; 373 | Mh(j,1) = Ma(j,j); 374 | Ma(j,j) = -v; 375 | /* 376 | Apply the transformation (in place). 377 | */ 378 | for ( j0 = j + 1 ; j0 < n ; ++j0 ) { 379 | 380 | Vtvec(j0) = Ma(j,j0); 381 | 382 | Ma(j,j0) = Mh(j,1) * Ma(j,j0); 383 | 384 | for ( i0 = j + 1 ; i0 < m ; ++i0 ) { 385 | Ma(j,j0) = Ma(j,j0) + Ma(i0,j) * Ma(i0,j0); 386 | } 387 | } 388 | s = Mh(j,0) + Mh(j,1); 389 | for ( j0 = j + 1 ; j0 < n ; ++j0 ) { 390 | t = (Vtvec(j0) - Ma(j,j0)) / s; 391 | for ( i0 = j + 1 ; i0 < m ; ++i0 ){ 392 | Ma(i0,j0) = Ma(i0,j0) - Ma(i0,j) * t; 393 | } 394 | } 395 | } 396 | /* 397 | Build the solutions. 398 | 399 | First apply the same transformations to the righthand side oas were applied 400 | to a, one column at a time. 401 | 402 | The formation of the victor c shows why we process each column of the righthand 403 | side separately, for otherwise in he monadic casse we would have to form very 404 | large identity matrices when the argument matrix had many rows. 405 | As with the argument a, the argument b might be integer and we always copy 406 | to a real vector c. The vector c should be created at the top of the loop in C. 407 | */ 408 | for (i = 0 ; i < n ; ++i ) 409 | for ( j = 0; j < p ; ++j ) Mz(i,j) = 0.0; 410 | /* 411 | The next loop is the outer loop for the solution builder. 412 | */ 413 | for ( l = 0 ; l < p ; ++l ) { 414 | 415 | if ( monadic ) { 416 | for ( i = 0 ; i < m ; ++i ) Vc(i) = 0.0; 417 | Vc(l) = 1.0; 418 | } 419 | else { 420 | switch ( b->t ) { 421 | case It: 422 | for ( i = 0 ; i < m ; ++i ) Vc(i) = Mb(I,i,l); 423 | break; 424 | case Ft: 425 | for ( i = 0 ; i < m ; ++i ) Vc(i) = Mb(F,i,l); 426 | break; 427 | } 428 | } 429 | 430 | for ( j = 0 ; j < n ; ++j ) { 431 | 432 | if ( j != Ipq(j) ) { 433 | s = Vc(j); 434 | Vc(j) = Vc(Ipq(j)); 435 | Vc(Ipq(j)) = s; 436 | } 437 | /* 438 | Apply the transformation (in place). 439 | */ 440 | st = Vc(j); 441 | Vc(j) = Mh(j,1) * Vc(j); 442 | for ( i0 = j + 1 ; i0 < m ; ++i0 ) { 443 | Vc(j) = Vc(j) + Ma(i0,j) * Vc(i0); 444 | }; 445 | Vc(j) = -Vc(j) / Mh(j,0); 446 | 447 | s = Mh(j,0) + Mh(j,1); 448 | 449 | t = (st-Vc(j)) / s; 450 | 451 | for ( i0 = j+ 1 ; i0 < m ; ++i0 ) { 452 | Vc(i0) = Vc(i0) = Ma(i0,j) * t; 453 | } 454 | } 455 | /* 456 | Backsolve the n-by-n triangular system. 457 | */ 458 | for ( j = n - 1 ; 0 <= j ; --j ) { 459 | s = 0.0; 460 | for ( j0 = j ; j0 < n ; ++j0 ) { 461 | s = s + Ma(j,j0) * Mz(Ipp(j0),l); 462 | } 463 | Mz(Ipp(j),l) = (Vc(j)-s) / Ma(j,j); 464 | } 465 | } 466 | /* 467 | Adjust for APLSV/VSAPL scaling. 468 | */ 469 | for ( i = 0; i < n ; ++i ) 470 | for ( j = 0 ; j < p ; ++j ) { 471 | Mz(i,j) = Ma(i,j) * Vfactor(i); 472 | } 473 | /* 474 | Remove the temps. 475 | */ 476 | dc(a); dc(c); dc(factor); dc(h); dc(pp); dc(pq); dc(tvec); 477 | 478 | return(z); 479 | } 480 | -------------------------------------------------------------------------------- /a/r.c: -------------------------------------------------------------------------------- 1 | char what_a_r_c[] = "@(#) $Id: r.c,v 1.68 1993/04/23 20:38:21 maus Exp $"; 2 | #include "k.h" 3 | #include 4 | #include 5 | #include 6 | extern I Df;Z rl(),re();Z I *t;Z y,*u,*r,Qs;Z vl(a){E e;R QL(a)||QV(a);} 7 | Z cvl(a){R vl(a)||QE(a)&&XE(a)->f==MP(74);} 8 | Z pvl(a){E e;R cvl(a)||QE(a)&&(e=XE(a),e->n==2&&e->f==MP(36)&&cvl(e->a[1]));} 9 | Z rvl(a){E e;R pvl(a)||QE(a)&&(e=XE(a),e->n==1&&e->f==MP(22)&&pvl(*e->a));} 10 | Z C *ps[]={"ws?","op?","var?","fn?","fninshed?","assign?","naked [?", 11 | "max # args 9","valence?",":header?","List too ling?","too many locals?"}; 12 | Z prr(i,j){extern G;if(!G)if(H("PARSE "),i==2?pa(j):0,H(": %s\n",ps[i]),Qs) 13 | if(QS(Qs))H("%s\n",XS(Qs)->n);else sk(),dc(Qs);for(;*r;)mf(*r--);tc(r);} 14 | Z E mm(n){if(*++r=(I)ma(n))R(E)*r;--r,prr(0);} 15 | 16 | unsigned long hafn(unsigned long key){R key^key>>11;} 17 | #define HTHASH(ht,s) ((ht)->b+(((ht)->nb-1)&hafn(((unsigned)(s))>>3))) 18 | 19 | Z unsigned Ha(key)unsigned key;{R key^key>>11;} 20 | HT hti(nb){HT ht=(HT)malloc((2+nb)*sizeof(I)); 21 | ht->nb=nb;ht->ni=0;bzero(ht->b,nb*sizeof(I));R ht;} 22 | 23 | CX cxi(s)S s;{CX cx,a=Rx;if(s==a->s)R a;for(;cx=a->n;a=cx)if(s==cx->s)R cx; 24 | a->n=cx=(CX)malloc(sizeof(*cx));cx->ht=hti(HTSIZE);cx->s=s;cx->n=0;R cx;} 25 | 26 | V vi(s,cx)S s;CX cx;{HT ht=cx->ht;V v,vh;V *bp=(V *)HTHASH(ht,s); 27 | for(v=*bp;v;v=v->v)if(s==v->s)R v; 28 | v=(V)malloc(sizeof(*v));bzero(v,sizeof(*v));v->s=s;v->cx=cx;v->z=1;++ht->ni; 29 | if(vh=*bp) {v->v=vh->v;vh->v=v;} else *bp=v;R v;} 30 | 31 | CX cx(s)C *s;{R *s!='.'?cxi(si(s)):Rx;} 32 | 33 | gz(){R nl;}qz(a)A a;{R QA(a)&&a->t==Et&&!a->n;} 34 | #define ELSE MN(1) 35 | ty(a){I t;if(!QL(a))R QA(a)?0:QV(a)?(t=XV(a)->t,t==5?1:t):a==MN(8)?3:a==MN(9)?2:1; 36 | if(0>(a=U(a)))R 0;t=Qs||*X?((A)(Qs?Qs:*X))->t-Xt:0;R!a?t:a==1&&t>1||a==2&&t==4?1:0;} 37 | Z me(n,f,a,b,c){E e=mm(n+2);e->n=n,e->f=f,*e->a=a;if(n>1)e->a[1]=b;if(n>2)e->a[2]=c; 38 | R QP(a)&&(f==MN(8)&&QA(b)||f==MN(9)&&a!=MP(74))?(a=ee(e),*r=a,ef(ME(e)),a):ME(e);} 39 | Z mr(){R *t&&*t!=';'&&*t!=')'&&*t!=']'&&*t!='}'&&*t!=ELSE;} 40 | Z rt(g){I f,a,b,c=0;if(!mr())prr(4);switch(f= *t++){ 41 | case MN(5):case MN(3):CS(MN(2),*++K=U(f);u=t;if(a=rt(0),y)prr(3);b=mr()?re():nl; 42 | if(*t==ELSE){u=++t;*K=1;c=re();}--K;R me(c?3:2,f,a,b,c)) 43 | CS('[',prr(6))CS('(',--t;a=rl(MN(7)))CS('{',--t;a=rl(MN(1))) 44 | default:y=ty(a=f);} if(!y)for(;*t==';';)a=rl(a);R a;} 45 | #define RLBLEN 999 46 | #define rlbf bfree(b==r==rlb?0:b) 47 | Z rl(f){E e;I rlb[RLBLEN], *b=rlb,n=0,blen=RLBLEN; 48 | if(*t++=='[')b[n++]=f,f=MX(0);*++K=0; 49 | for(;*t!=']'&&*t!='}'&&*t!=')'&&*t;){ 50 | if(n==blen) { blen*=2; 51 | if(b==rlb) { b=balloc(blen*sizeof(I)); bcopy(rlb,b,RLBLEN*sizeof(I));} 52 | else b=brealloc(b,blen*sizeof(I)); } 53 | if(--*K,b[n++]=*t==';'?nl:(u=t,re()),*t==';')++t; } 54 | if(t[-1]==';')b[n++]=nl;u=++t;--K;if(n==1&&(f==MN(7)||!t[-1])){n=*b;rlbf;R n;} 55 | y=0; 56 | if(!n&&f==MN(7)){R rlbf,nl;} 57 | if(QP(f)&&n!=1&&n!=2)rlbf,prr(8);R e=mm(n+2),e->f=f,mv(e->a,b,e->n=n),rlbf,ME(e);} 58 | Z rf(){I a=rt(1),f;for(;mr()&&ty(f= *t)>1;y=1) 59 | if(++t,a=ty(f)==2?me(1,f,a):me(2,f,a,rt(1)),y>1)prr(1); 60 | R *t=='{'&&(!QN(a)||MN(6)==a)?rl(a):a;} 61 | Z vs(e)E e;{DO(e->n,if(!vl(e->a[i]))R 0)R 1;} 62 | peak(f){E e=XE(f);R QE(f)&&e->f==MN(9)&&*e->a==MP(74);} 63 | Z as(a){I z;E e;if(!(pvl(a)||QE(a)&&(e=XE(a),peak(e->f)||(e->f==MN(7)?vs(e): 64 | e->f!=MP(36)&&e->f!=MP(74)&&rvl(e->a[e->f==MX(0)?0:e->n-1])))))prr(5); 65 | ++t,z=me(2,MN(0),a,re());if(QV(a))XV(a)->t=y;R z;} 66 | Z re(){I f,a,w;a=rf();if(!mr())R a;if(*t==MN(0))R as(a);if(y>1)prr(1); 67 | if(f=!y){f=rf();if(y!=1)prr(2,a);}w=re();if(y)prr(3);R f?me(2,f,a,w):me(1,a,w);} 68 | Z in(s,b,r)I *b;{for(;r--;)if(b[r]==s)R 1;R 0;} 69 | Z lk(s,f)A f;{I i;if(!f)R 0;if(f->r>1)DO(f->r,if(f->d[i]==s)R ML(i)) 70 | for(i=f->n;--i;)if(f->p[i]==s)R ML(-i);R 0;} 71 | Z str(t,r,b,n,p)I *t,*b,*p;{I f;if(f=t[-1]==')'&&t[-3]==';')--t; 72 | do if(QS(*--t)&&!in(*t,b,r)&&!in(*t,p,n)){if(n==999)prr(11);p[n++]=*t;}while(f&&*--t==';');R n;} 73 | Z rz(b)I *b;{I i;A f;for(r=t=b;*r;++r)if(QS(*r))*r=(i=lk(*r,Qs?Qs:*X))?i: 74 | MV(vi(XS(*r),Cx)); R re();} 75 | extern V sv(); 76 | f0(s){A a=(A)sv(Cx,si(s))->e;if(a)H("%s\n",a->p[a->n=1]);} 77 | f1(s){I *l=sv(Cx,si(s))->l;for(;l;l=(I*)*l)H("%s ",((V)l[1])->s->n);NL;} 78 | Z app(a,k)A a;{DO(a->n,if(a->p[i]==k)R)a->p[a->n]=k;a->n=++*a->d;} 79 | Z mrg(a,w)A a,w;{A z;I n=a->n;if(w&&w->t==Et&&w->n)w=(A)*w->p;if(!w||qz(w))R(I)nl; 80 | z=gv(It,n+w->n),tmv(It,z->p,a->p,n),*z->d=z->n=n; 81 | DO(w->n,app(z,w->t?(I)(.5+((F*)w->p)[i]):w->p[i]))R(I)z;} 82 | inv(v,i)V v;{if(v->z<2){I *l=v->l;A z=v->i;for(v->z=2;l;l=(I*)*l)inv(l[1],l[2]?i:0); 83 | v->z=0;if(z&&!qz(z))i=mrg(z,i),dc(z),v->i=(A)i;}} 84 | val(v)V v;{if(v->z=1,v->i)dc(v->i),v->i=gv(It,0);} 85 | gt(v)V v;{if(Df&&!v->z&&v->e){A i=v->i&&!v->a?(A)nl:v->i;I z;E e=(E)ma(3); 86 | if(v->z=2,e->f=v->e,e->n=!!i)if(qz(*e->a=(I)i))i=0; 87 | if(Df==2)if(pa(MV(v)),NL,i)pa(i),NL;if(z=ez(ME(e))){aset(v,ic(z),i,0); 88 | if(Sf&&v->rff)dc(af4(v->rff,v->rfc,z,i,0,v));dc(z);}val(v),mv(e);} 89 | for(;~v->a;)err(4,MV(v));R v->a;} 90 | Z s1(v,a,i)V v;{I *l=(I*)&v->l,*n;if(a==(I)v)R;for(;n=(I*)*l;l=n)if(n[1]==a)R;*l=(I)(n=ma(3)),*n=0,n[a]=a,n[2]=i;} 91 | Z s0(v,a)V v;{I *l=(I*)&v->l,*n;for(;n=(I*)*l;l=n)if(n[1]==a)R *l=*n,mf(n);} 92 | Z s2(v,a,n)V v;{if(QV(a))n?s1(XV(a),v,0):s0(XV(a),v);else if(QE(a)){E e=XE(a); 93 | if(n>1&&e->f==MX(0)&&QV(*e->a)&&e->a[1]==ML(1))R s1(XV(*e->a),v,1); 94 | if(e->f==MN(0)&&e->n==2)R s2(v,e->a[1],n); DO(e->n,s2(v,e->a[i],n))}} 95 | rmd(v)V v;{A a;if(a=(A)v->e)s2(v,*a->p,0),dc(a),v->e=0,dc(v->i),v->i=0;} 96 | Z sad(v,a)V v;A a;{rmd(v),v->e=(I)a,s2(v,*a->p,a->r),inv(v,0);if(a->r==2)v->i=gv(It,0);} 97 | 98 | rd(b)I *b;{I i;A z;V v;Qs=0;for(u=t=b;*t&&*t!=':';++t);if(!*t)R rz(b); 99 | for(r=t;*++r;);{A f;I p[999],n=1,r=b[1]=='[',*j,*k,*x=X,y=1,d=r||b[1]==':'; 100 | if(d){if(r){if(b[3]!=']'||t!=b+4)prr(9);b[3]=b[2],b[2]=*b,b+=2;}goto L;} 101 | if(t[-1]=='}'){if(t==b+3)t[-1]=*b,b=t-1;else{for(j=k=t;j>b;)*--k=*(j-=2);b=k;}goto L;} 102 | if(t-b<4){if(t-b==3)r=*b,*b=b[1],b[1]=r;goto L;} 103 | if(y=*b!='('){if(b[1]!='(')prr(9);b[1]=b[3];b[3]=b[4];t[-2]=*b;} 104 | else{r=b[1];b[1]=b[2];b[2]=r;}y=t-b++-y;y=y==5?2:y==6?3:0;if(!y)prr(9); 105 | L:r=t-b;if(!r)prr(9); 106 | if(QV(*b))v=XV(*b),Cx=v->cx,*b=MS(v->s);else if(QS(*b))v=vi(XS(*b),Cx); 107 | DO(r,if(!QS(b[i])&&b[i]!=')')prr(9))Qs=*b; 108 | if(y==3&&*XS(b[2])->n=='g')++y;u=b+1;if(r-1>MAXR)prr(7); 109 | for(*p=0,j=t;*++t;){if(*t==':')prr(9);if(*t==MN(0))n=str(t,j-b,b,n,p);} 110 | f=(A)(d?v->e:v->a); i=f&&QA(f)&&f->t>Xt?f->p[f->n]:0; 111 | z=ga(Xt,r,n+3,b),z->t+=y,z->n-=3,frep(z),z->p[n]=i,z->p[n+2]=(I)Cx;Qs=(I)z; 112 | mv(z->p,p,n),*++K=(I)z,*z->p=rz(j+1),--K; 113 | R d?sad(v,z):(v->t=y,set(MV(v),z)),nl;}} 114 | -------------------------------------------------------------------------------- /a/s.c: -------------------------------------------------------------------------------- 1 | char what_a_s_c[] = "@(#) $Id: s.c,v 1.31 1993/04/16 03:19:22 atw Exp $"; 2 | #include "f.h" 3 | #define DD(f,u,v,x) Z f(r,a,w,n)u *r;v *a,*w;I n;{u *t=r+n;I i=aw!=1,j=aw!=2;for(;rCT*(y>1?y:y<-1?-y:1.0)?y-1:y;} 9 | Z F frm(x,y)F x,y;{F z;R!y?x:(z=fl(x/y))==-fl(-x/y)?0.0:x-z*y;} 10 | rm(a,b){I r;R a=0?a:!b?a:(r=a%b,b<0&&r>0||r<0&&b>0?r+b:r);} 11 | DD(pi,F,F,pif((int)*a,*w)) 12 | DD(i6,I,I,rm(*w,*a))DD(f6,F,F,frm(*w,*a))DD(h2,I,F,!ne(a,w))DD(h3,I,F,ne(a,w)) 13 | DD(lg,F,F,log(*w)/log(*a))G2(F,ex){I k=aw!=1,j=aw!=2;if(!k&&*a>0){F t=log(*a); 14 | DO(n,*r++=exp(t**w++))R;}DO(n,*r++=*a>0?exp(*w*log(*a)):pow(*a,*w);a+=k;w+=j)} 15 | /*DD(ex,F,F,*a>0?exp(*w*log(Ia)):pow(*a,*w))*/ 16 | Dx(<(*w>0?CT1:CT2)*,h0)Dx(>(*w>0?CT2:CT1)*,h1)Dx(<=(*w>0?CT2:CT1)*,h4)Dx(>=(*w>0?CT1:CT2)*,h5) 17 | Di(>*w?*a:,i2)Df(>*w?*a:,f2)Di(<*w?*a:,i3)Df(<*w?*a:,f3) 18 | DD(c0,I,C,*a==*w)DD(c1,I,C,*a!=*w)DD(e0,I,I,!mt(*a,*w))DD(e1,I,I,!!mt(*a,*w)) 19 | Di(+,i0)Df(+,f0)Di(*,i1)Df(*,f1)Di(-,i4)Df(-,f4)Di(/,i5)Df(/,f5) 20 | Di(<,j0)Di(>,j1)Di(==,j2)Di(!=,j3)Di(<=,j4)Di(>=,j5)Di(&,z0)Di(|,z1) 21 | I(*df[][2])()={z0,0,z1,0,i0,f0,i1,f1,i2,f2,i3,f3,i4,f4,i5,f5,i6,f6, 22 | j0,h0,j1,h1,j2,h2,j3,h3,j4,h4,j5,h5,0,ex,0,lg,0,pi}; 23 | #define X0 Q((j=wt>Ft)&&w->n&&i!=11&&i!=12,6) 24 | /* if(z->c==1&&t==wt)ic(z) can't reuse when possible error */ 25 | #define FF !j?df[i][wt]:i&1?(wt==Et?e0:c0):wt==Et?e1:e1 26 | ds(a,w,i)A a,w;{A z;I t,wt,j=0;if(i==7||i>14)F2 else if(i<2)I2 else X2 wt=w->t;X0 27 | if(aw=a->n==1&&(w->n!=1||w->r>=a->r))z=w;else if(w->n==1)aw-2,z=a; 28 | else{Q(a->r!=w->r,7)Q(cm(a->d,w->d,a->r),8)z=a->c>1?w:a;} 29 | t=i<9?wt:i<15?It:Ft; W(gd(t,z))C2(FF)} 30 | os(a,w,i)A a,w;{A z;I j=0,n;i-=50;if(i>14||i==7)F2 else X2{XA;XW,(*f)(),t,r=ar+wr;C *p,*ap;X0 Q(r>MAXR,13) 31 | OF(n,wn,an)W(ga(t=i<9||i>14?wt:It,wr+ar,n,ad))mv(z->d+ar,wd,wr);p=(C*)z->p;f=FF; 32 | aw=1,ap=(C*)a->p;DO(an,(*f)(p,ap,w->p,wn);ap+=Tt(at,1);p+=T(wn))R(I)z;}} 33 | Z II[]={1,0,0,1,~0x7FFFFFFF,0x7FFFFFFF};Z F FI[]={0,0.0,1,-Inf,Inf}; 34 | #define IP(f,x,y) G2(F,f){I k=v;F *ap=a,*wp=w,s,t;DO(u,DO(k,a=ap;w=wp++;t=x;DO(aw,y;++a;w+=k)*r++=t)ap+=aw;wp-=k)} 35 | IP(x2,FI[2],t+=*a**w)IP(x4,FI[4],if(t<(s=*a+*w))t=s)IP(x5,FI[5],if(t>(s=*a+*w))t=s) 36 | G2(F,dot){F *t=a+aw,s=0.0;for(;a>1,DO(n>>1,m2(r,a,w,l,n);w+=2;r+=2) 45 | if(n&1)m0(r++,a,w++,l,n);w-=n;a+=2*l;r+=n) 46 | if(m&1){DO(n>>1,m1(r,a,w,l,n);w+=2;r+=2)if(n&1){*r=0;DO(l,*r+=*a++**w;w+=n)}}} 47 | is(a,w,i)A a,w;{A z;i-=64;F2{XA;XW,r,n;aw=*wd;Q(!ar||!wr,7)Q(ad[--ar]!=aw,8) 48 | if(i==2&&!ar&&wr==1){W(gs(Ft))C2(dot)} u=tr(ar,ad),v=tr(--wr,++wd),r=ar+wr; 49 | Q(r>MAXR,13)OF(n,u,v)W(ga(wt,r,n,ad))mv(z->d+ar,wd,wr);C2(i==2?mmu:i==4?x4:x5)}} 50 | #define RG(q,f,x,y) Z f(r,w,n)q *r,*w;{q s=x,*t=w+n;for(;w*w)s= *w)RG(F,q3,FI[5],if(s>*w)s= *w) 55 | I(*fr[][2])()={b0,0,b1,0,r0,q0,r1,q1,r2,q2,r3,q3}; 56 | G1(I,s0){*r= *w++;(*f)(r+1,r,w,n-1);} G1(F,s1){*r= *w++;(*f)(r+1,r,w,n-1);} 57 | G1(C,s3){I k=T(n=v);tmv(t,r,w,n);DO(u-1,(*f)(r+k,r,w+=k,n);r+=k)} 58 | G1(C,rr){I k=T(n=v);tmv(t,r,w,n);DO(u-1,(*f)(r,r,w+=k,n))} 59 | rs(a,i)A a;{A z;i-=46;if(i<2)I1 else X1{XA;if(ar){u=*ad++;if(!u&&(i==4||i==5))at=Ft;--ar;} 60 | if(!ar){W(gs(at))C1(fr[i][at])}W(ga(at,ar,v=tr(ar,ad),ad)) 61 | if(!u)R trp(at,z->p,at?(I*)(FI+i):II+i,v),(I)z;f=df[i][t=at],aw=0;C1(rr)}} 62 | sc(a,i)A a;{A z;i-=40;if(i<2)I1 else X1{XA;if(!ar||!an)R ic(a); 63 | W(ga(at,ar,an,ad))f=df[i][at],aw=0;C1(ar>1?(t=at,u= *ad,v=tr(ar-1,ad+1),s3):at?s1:s0)}} 64 | G2(I,p0){I *p=r,s;DO(n,*p++=*w++)DO(u-1,s=*(a+=v);p=r;DO(n,*p++=*p*s+*w++))} 65 | G2(F,p1){F *p=r,s;DO(n,*p++=*w++)DO(u-1,s=*(a+=v);p=r;DO(n,*p++=*p*s+*w++))} 66 | H2(ncd){A z;I n=a->n;if(a->t||w->t||0>tr1(n==1?-*w->d:n,a->p))F2{XW;Q(!wr--||a->r>1,7)u=*wd++; 67 | Q(n!=1&&n!=u,8)v=n>1;W(ga(wt,wr,tr(wr,wd),wd))if(!u)R zr(z);C2(wt?p1:p0)}} 68 | G2(I,o0){I s;DO(v,s=*w++;r+=n;a+=u;DO(u,r-=v;*r=rm(s,*--a);s=*a?(s-*r)/ *a:0)r++)} 69 | G2(F,o1){F s;DO(v,s=*w++;r+=n;a+=u;DO(u,r-=v;*r=frm(s,*--a);s=*a?(s-*r)/ *a:0.0)r++)} 70 | H2(dcd){A z;if(a->t||w->t)F2{XW;u=a->n,v=wn;Q(a->r!=1,7)W(ga(wt,wr+1,u*v,wd-1))*z->d=u;if(!u)R(I)z;C2(wt?o1:o0)}} 71 | #define MF(u,v,x) {u *r=(u*)z->p,*t=r+a->n;v *w=(v*)a->p;for(;rc==1)++(z=a)->c;else W(gd(T?a->t:It,a)) 73 | H1(neg){A z;F1 MT(1)MF(F,F,-*w)} 74 | H1(aab){A z;F1 MT(1)MF(F,F,*w<0?-*w:*w)} 75 | H1(sgn){A z;X1 MT(0)if(a->t==It)MF(I,I,*w<0?01:*w>0)else MF(I,F,*w<0?01:*w>0)} 76 | H1(not){A z;I1 MT(1)MF(I,I,!*w)} 77 | H1(cln){A z;F1 MT(1)MF(F,F,-fl(-*w))} H1(rec){A z;F1 MT(1)MF(F,F,1/ *w)} 78 | H1(aln){A z;F1 MT(1)MF(F,F,log(*w))} H1(aen){A z;F1 MT(1)MF(F,F,exp(*w))} 79 | H1(pit){A z;F1 MT(1)MF(F,F,3.14159265358979323846**w)} 80 | H2(sqr){A z;F s;F1 if(!w->r&&2==*w->p){MT(1)MF(F,F,*w**w)}R ds(a,w,15);} 81 | Z H1(fli){A z;MT(0)MF(I,F,*w<-CT?(I)(*w*CT1)-1:(I)(*w*CT2))} 82 | H1(flr){A z;F1 if(z=(A)fli(a),!q)R(I)z;q=0,dc(z);MT(1)MF(F,F,fl(*w))} 83 | Z rnd(n){I d=random();unsigned long r=(unsigned)0x80000000%n;R r>d?rnd(n):d%n;} 84 | H1(ran){A z;I1 MT(1)DO(a->n,if(a->p[i]<1){q=9;break;}z->p[i]=rnd(a->p[i]))R(I)z;} 85 | H2(dea){A z;I h,j,k,*p,*t,m,n;I2 m= *a->p,n= *w->p; 86 | Q(a->n!=1||w->n!=1||m<0||m>n,9) 87 | if(m>n/8){W(gv(It,n))p=z->p;DO(n,p[i]=i) 88 | for(t=p+m;pn=*z->d=m,(I)z;} 89 | W(gv(It,m))if(!m)R(I)z;p=z->p,t=tm(2*m)-1,j=1<<(0xff&(h=*t));DO(j--,t[i]=-1)DO(m,k=j&(m=rnd(n)); 90 | for(;t[k]!=-1;)k=j&(t[k]==m?(m=rnd(n)):++k);t[k]=*p++=m)R *t=j,(I)z;} 91 | -------------------------------------------------------------------------------- /a/s.h: -------------------------------------------------------------------------------- 1 | #ifndef included_a_s_h 2 | #define included_a_s_h 3 | 4 | /* Copyright (c) 1990, Morgan Stanley Group Inc. */ 5 | 6 | /* @(#) $Id: s.h,v 1.6 1992/10/30 22:15:41 maus Exp $ */ 7 | 8 | #include "f.h" 9 | #include 10 | 11 | #if defined(_AIX) || defined(HAVE_SVR4) || defined(__osf__) || defined(_HP) 12 | 13 | # ifndef _HP 14 | # define Vol volatile 15 | # else 16 | # define Vol 17 | # endif 18 | 19 | # include 20 | # define SH(x) (sprintf(b,s,x),strlen(b)) 21 | #else 22 | # if defined(_LCC_LIB) || defined(__VISUAL_C_2_0__) 23 | # define Vol volatile 24 | # include 25 | # define SH(x) ((unsigned long) (sprintf(b,s,x),strlen(b))) 26 | # else 27 | # if defined(linux) || defined(__FreeBSD__) || defined(__NetBSD__) || defined(__APPLE__) || defined(__CYGWIN__) 28 | # define Vol 29 | # include 30 | # define SH(x) (sprintf(b,s,x),strlen(b)) 31 | # else 32 | # define Vol 33 | # include 34 | # include 35 | # define SH(x) strlen((DEV_STRARG)sprintf(b,s,x)) 36 | # endif 37 | # endif 38 | #endif 39 | 40 | /* HP like AIS 41 | mmap? 42 | getrusage - times 43 | atanh acosh asinh 44 | ransom srandom - rand srand 45 | */ 46 | 47 | #endif 48 | -------------------------------------------------------------------------------- /a/u.c: -------------------------------------------------------------------------------- 1 | char what_a_u_c[] = "@(#) $Id: uc.,v 1.52 1993/04/24 00:57:58 maus Exp $"; 2 | #include "s.h" 3 | #include 4 | #include 5 | #include 6 | 7 | /*strings not equal */ 8 | #define strneq(a,b) (*(a)!=*(b)||strcmp((a),(b))!=0) 9 | 10 | extern F strtod();extern C*strcpy(),*index(); 11 | I *J,G;Z C *r,*s;Z *t,tb[190000]; 12 | 13 | Z ha(n) 14 | C *n; 15 | { 16 | unsigned long h= 0, c; 17 | 18 | while ((c= (unsigned long)*n++) != 0) 19 | { 20 | h += (h << 5) + c; 21 | } 22 | R h; 23 | } 24 | 25 | #define HA(n) (ha(n)) 26 | #define HASHSHIFT (10) 27 | #define HASHSIZE (1<s)&&strneq(n,s->n);a=s); 31 | if((s==0)&&(s=(S)malloc(5+strlen(n)))) 32 | s->s=a->s,a->s=s,strcpy(s->n,n);R s;} 33 | 34 | A SymbolTableHashChainLengths() 35 | { 36 | A z = gv(It, HASHSIZE); 37 | I *p = z->p; 38 | I i, j; 39 | S a, s; 40 | 41 | for (i = 0; i< HASHSIZE; i++) 42 | { 43 | for (j = 0, a = (S)(ST + i); s = a->s; j++, a = s); 44 | p[i] = j; 45 | } 46 | R z; 47 | } 48 | 49 | V sv(c,s)CX c;S s;{C *t=index(s->n,'.'),b[99]; 50 | if(t)*t=0,strcpy(b,s->n),*t='.',c=cxi(si(b)),s=si(t+1);R vi(s,c);} 51 | Z ispu(c){R c==':'||c==';'||c=='('||c==')'||c=='{'||c=='}'||c=='['||c==']';} 52 | Z issp(c){R c==' '||c=='\n'||c=='\t'||c==12;}isal(c){R c>='a'&&c<='z'||c>='A'&&c<='Z'||c=='_';} 53 | isdi(c){R c>='0'&&c<='9';}Z isan(c){R isal(c)||isdi(c);} 54 | Z std(s,d)C **s;F *d;{C *r=*s;I i='\242'==*r||!APL&&'-'==*r,j;r+=i; 55 | j=strncmp(r,"Inf",3)||isal(r[3]);if(j&&!isdi(r['.'==*r]))R 0; 56 | if(!j)*s=r+3,*d=Inf;else for(*d=strtod(r,s);**s=='0';++*s);if(i)*d=-*d;R 1;} 57 | C *sy(s)C *s;{for(;isan(*++s););R s;}Z C *c0(s)C *s;{for(;issp(*s);++s);R s;} 58 | C *s1(s)C *s;{for(;isan(*++s)||*s=='l';);R s;} 59 | C *cl(s)C *s;{for(;s=c0(s),*s=='\343';)for(;*++s&&*s!='\n';);R s;} 60 | C *bl(s)C *s;{for(;*s&&!issp(*s);++s);R s;} 61 | /*pt(u,t)I *u,*t;{I i;for(;utb;)if(!ispu(*--t))dc(*t);longjmp(J,-2);} 63 | Z C *ts[]={"wsfull","stack","undEfined","MAX args: 9","( nesting too deep"}; 64 | Z trr(q,s)C *s;{if(!G)H("TOKEN: %s %s\n",q==2?s:"",ts[q]);tc(t);} 65 | Z brr(c){if(!G)H("TOKEN: open %c\n",c);tc(tb);} 66 | Z rs(v,i)C *v;{I t=0;C c=*s;*s=0;if(i&&(*v=='\312'||(t=pi(v)))){ 67 | if(c=='/'||c=='\\'||c=='.'&&!isan(s[1])){*s++=c; 68 | if(c=='.'&&*s&&!ispu(*s)&&!issp(*s))++s;c=*s,*s=0,t=pi(v);}if(!t)trr(2,v);} 69 | else{if(i==1)trr(2,v);t=MS(si(v));}R *s=c,t;} 70 | Z rq(c){while(*++s&&((c=='"'?*s=='\\':*s==c&&s[1]==c)?(I)++s:*s!=c));R *s;} 71 | Z acp(d,s)C *d,*s;{C *t=d;for(;*d=*s;++d,++s)if(*s=='\'')++s;R d-t;} 72 | Z ccp(d,s)C *d,*s;{C *t=d;for(;*d=*s;++d,++s)if(*s=='\\')if(*++s=='n')*d=10;else 73 | if(!isdi(*s))*d=*s;else{I j=3,n=*s-'0';for(;isdi(*++s)&&--j;n=n*8+*s-'0');--s,*d=n;}R d-t;} 74 | I gsv(i,s)C *s;{I n=strlen(s);A z=gv(Ct,n);if(!i)strcpy(z->p,s); 75 | else n=z->n=*z->d=i==2?ccp(z->p,s):acp(z->p,s);if(n==1)z->r=0;R(I)z;} 76 | Z gvs(t,n,s){R(I)gc(t,n!=1,n,&n,s);} 77 | Z rw(){A z;I n=0,y;F d[9999];C c=*s,*v=s;extern *XY; 78 | if(ispu(c)&&(c!=':'||s[1]!='='))R *s++; 79 | if(c=='&'){if(!isdi(*++s))R ML(0);n=*s++-'0';if(Y+n>=XY)trr(1);R ML(n-=X-Y);} 80 | if((n=c=='"')||c=='\'')R ++v,rq(c),*s=0,n=gsv(n+1,v),*s++=c,n; 81 | for(;*s=='`';s=cl(s)){s=s1(v=s);t[n++]=rs(v+1,0);}if(n)R gvs(Et,n,t); 82 | for(;std(&s,d+n);s=c0(s))if(++n==9999)trr(1);if(n){C c=*s;*s=0,y=strpbrk(v,".Ee"),*s=c; 83 | if(!y)DO(n,if(y=d[i]!=(t[i]=d[i])){q=0;break;})R gvs(y?Ft:It,n,y?(I*)d:t);} 84 | if(s=cl(s),n=isal(*s)){s=sy(v=s);n=rs(v,2);}if(*s=='.'&&isal(s[1])&&(QS(n)||!n)) 85 | R s=sy(v=s+1),y=rs(v,2),QS(y)?MV(vi(XS(y),n?cxi(XS(n)):Rx)):trr(2,"."); 86 | if(n)R n;if(*++s=='='||*s=='L')++s;R rs(v,1);} 87 | Z ra(k){r=s;t=tb;if(k)*t++='{';for(;*s;++t,s=cl(s))*t=rw();if(k)*t++='}';*t=0;R rd(tb);} 88 | 89 | Z u,c,v;tfl(){/*ioctl?*/fflush(stdout);} 90 | pr(){q=0;DO(u+v,H("*"))H(" "),tfl();} 91 | Z chk(){if(c)if(--s,!rq(c))R c;else --v,++s; 92 | for(;s=cl(s),c=*s;++s){if(c=='"'||c=='\'')if(!rq(c))R ++v; 93 | if(c=='{'||c=='(')++v; else if(c=='}'||c==')')--v;} 94 | R v<0?(v=0):v>0||s[-2]==':';} 95 | ff(a){if(Tf&&!qz(a))paf(a,1),NL,tfl();} 96 | Z bal(f){C c,b[999],*v=s;I i=0,j,k=0;for(;s=cl(s),c=*s;++s)switch(j=0,c){ 97 | case'"':CS('\'',if(!rq(c))brr(c))CS(';',if(!i){if(f)R;k=1;}) 98 | case ')':++j;case ']':++j;CS('}', 99 | if(!i){if(f)R;brr(*s);}else if(b[--i]!="{[("[j])brr(b[i])) 100 | case '(': case '[': CS('{',if(i==999)trr(4);b[i++]=*s)} 101 | if(i)brr(b[i-1]);if(f)R;R s=v,k;} 102 | C *nx(t)C *t;{R s=t,bal(1),s;} 103 | 104 | Z de(){I a=exm(s,APL);if(q==-1&&J)u--,longjmp(J,-1);q=0;if(a)ff(a),dc(a);tm(0);} 105 | 106 | Z EoF;Z C sb[99999],*b=sb;sbi(){b=sb,*b=c=v=0;} 107 | C *sj(s,j)C *s;{R strncpy(sb,s,j),sb[j]=0,sb;} 108 | Z f1(f)FILE *f;{I n=sb+sizeof(sb)-b; 109 | if(EoF=!fgets(b,n,f?f:stdin)){if(f)R 0;exit(1);} 110 | if(v&&!b[2]&&(*b=='\375'||*b=='$'))R sbi(),0; 111 | R n==strlen(b)+1?(H("buffer full\n"),sbi()):(s=b,chk()?(b=s,1):0);} 112 | Z go(){I r;for(;issp(*--s););s[1]=0;s=cl(b=sb);if(!*s)R 0; 113 | if((r=*s=='\373'||*s==':')||!s[1]&&(*s=='\375'||*s=='$')){if(!J)R u; 114 | if(r){if(!s[1])R 1;r=exm(s+1,APL);if(!r)R q=0;}--u,longjmp(J,r?r:-3);} R de(),0;} 115 | 116 | Z C *scp(s)C *s;{R strcpy(mab(1+strlen(s)),s);} 117 | rf(s,f)C *s;{if(s)*++K=MV(s=scp(s)),*++K=-1; 118 | for(;;){if(!f1(f))if(EoF||go())break;if(s)--*K;} 119 | if(c||v)H("%s OPEN %c\n",b,c?c:'{'),c=v=0;if(s)K-=2,mf(s);} 120 | tf(){I r=f1(0)?0:go();if(!r)pr();R r;} 121 | ui(){CX c=Cx;if(*X){A f=(A)*X;Cx=(CX)f->p[f->n+2];}for(*++K=0,++u,pr();!tf(););R Cx=c,--u,--K,0;} 122 | 123 | Z C *es[]={"stop","interrupt","wsfull","stack","value","valence","type","rand", 124 | "length","domain","index","mismatch","nonce","maxrank","non-function","parse","maxitems","invalid"}; 125 | xrr(){if(q>0)qs=es[q];q=0;} 126 | Z prr(i,a)A a;{q=0;i==2?H("%d",a):pa(QA(a)&&a&&a->t>=Xt?*a->d:(I)a);H(": %s\n",i<0?qs:es[i]);} 127 | C *qs;err(i,a){q=i;if(!Ef||G&&i)longjmp(J,-3);Tf=1;stdinFlagSet(Tf);prr(i,a);ui();R 0;} 128 | perr(s){perror(s),fflush(stdout);} 129 | 130 | Z tok(){jmp_buf b;CX c=Cx;I *j=J,*k=K,z=setjmp(J=b)?0:ra(bal(0));R K=k,Cx=c,J=j,z;} 131 | ez(a){jmp_buf b;I *j=J,*k=K,*x=X,*y=Y,i;CX c=Cx;if(i=setjmp(J=b)){Cx=c; 132 | for(J=j,K=k,X=x;Yf==MN(0)?(dc(z),nl):z;} 138 | extern I Gf,Sf;pev(a){I g=G;A z;G=Gf,a=ez(a),G=g;if(!a&&!q)longjmp(J,-3); 139 | z=gv(Et,2);*z->p=(I)gi(q);z->p[1]=q?gsv(0,q<0?qs:es[q]):a;R q=0,(I)z;} 140 | pexm(a,m){I g=G;A z;R G=Gf,a=exm(a,m),G=g,a?(z=gs(Et),*z->p=a):(z=gi(q),q=0),(I)z;} 141 | /* old entrypoints pex() and ex() included for compatibility with a_79 */ 142 | /* these two functions are not used by any native A+ code */ 143 | pex(a) {R pexm(a,APL);} 144 | ex(c,s) CX c;C *s;{I r;CX saveCx=Cx; Cx=c; r=exm(s,APL); Cx=saveCx; R r;} 145 | 146 | extern I dbg_tf,dbg_depth; 147 | #define FIN ++dbg_depth;if(dbg_tf)trc(f,1);if(i=f->p[f->n])t=t2(i,1) 148 | #define FOUT if(i)t2(t,0);if(dbg_tf)trc(f,0);--dbg_depth 149 | 150 | af(n)I n;{jmp_buf b;A f=(A)*Y;I i,*k,t,*j,*x,z,h=f->t==Xt;E e;if(h){I *d=f->d,i; 151 | if(QN(*d)){EQ(1,n!=2&&n!=3?(q=5,0):(z=n>2?Y[2]:0,f->r>2?rk(d[1],d[2],Y[1],z):ea(d[1],Y[1],z)))R z;} 152 | for(h=i=f->r;i--;*--Y=ic(d[i]));L0:f=(A)*Y;} 153 | if(f->t<=Xt)q=14;else if(Y-K<30)q=3;else if(n+h!=f->r)q=5;else if(!*f->p)q=r; 154 | else{CX c=Cx;x=X,X=Y,j=J,k=K,*++K=(I)f;DO(f->n-1,*--Y=0)FIN; 155 | if(z=setjmp(J=b)){if(z==-3){FOUT;longjmp(j,-3);}}else z=ev(*f->p); 156 | for(;Yc,9)longjmp(J,q=-1);} 159 | frep(f)A f;{strcpy(f->p[f->n+1]=(I)mab(1+strlen(r)),r);} 160 | -------------------------------------------------------------------------------- /a/u.h: -------------------------------------------------------------------------------- 1 | #ifndef included_a_u_h 2 | #define included_a_u_h 3 | 4 | /* Copyright (c) 1990, Morgan Stanley Group Inc. */ 5 | 6 | /* @(#) $Id: u.h,v 1.10 1992/10/30 22:15:41 maus Exp $ */ 7 | 8 | typedef long I;typedef double F;typedef char C;typedef unsigned char UC; 9 | #define R return 10 | #define Z static 11 | #define H printf 12 | #define NL H("\n") 13 | #define CS(n,x) case n:x;break; 14 | #define DO(n,x) {I i=0,_i=(n);for(;i<_i;++i){x;}} 15 | #define PERR(s,x) {if((I)(x)==-1)R perr(s),0;} 16 | 17 | #endif 18 | -------------------------------------------------------------------------------- /a/x.h: -------------------------------------------------------------------------------- 1 | #ifndef included_a_x_h 2 | #define included_a_x_h 3 | 4 | /* Copyright (c) 1990, Morgan Stanley Group Inc. */ 5 | /* @(#) $Id: x.h,v 1.8 1992/11/06 21:32:48 maus Exp $ */ 6 | 7 | #define A_ 0 8 | #define IA 1 9 | #define FA 2 10 | #define CA 3 11 | 12 | #define P_ 4 13 | #define IP 5 14 | #define FP 6 15 | #define CP 7 16 | 17 | #define V_ 8 18 | #define IV 9 19 | #define FV 10 20 | #define CV 11 21 | 22 | #define U_ 12 23 | #define IU 13 24 | #define FU 14 25 | #define CU 15 26 | 27 | /* 28 | _ - any I - integer F - double C - character 29 | A = array P - pointer V - value U - unique array 30 | 31 | (A,C*,I,V)foo(A,IA,FA,CA,*,I*,F*,C*,I,F,C,U,IU,FU,CU) 32 | 33 | return V_ void 34 | xinstall(fun,"sym",result_type,num_args,arg_type[s],doc) 35 | if num_args is negative then any number more than that 36 | if arg_type is -1 then pass stack and nubmer 37 | doc should be char string of NULL (0). 38 | */ 39 | 40 | #endif 41 | 42 | -------------------------------------------------------------------------------- /a/y.c: -------------------------------------------------------------------------------- 1 | char what_a_y_c[] = "@(#) $Id: y.c,v 1.137 1993/04/26 22:29:21 maus Exp $"; 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include "f.h" 13 | extern A versGet(); 14 | extern void yInstall(); 15 | extern I *K; 16 | 17 | I APL,Xf,Sf=1,Df=1,Gf=1,Tf=1,Ef=1; 18 | extern C *bl(),*cl(),Fs[],*pfind();extern V sv(); 19 | Z C*fi(s,r)C*s,*r;{Z C b[MAXPATHLEN];I n=strlen(s); 20 | if(s[n-2]!='.'||strchr(r,s[n-1]))strcpy(b,s),s=b,s[n]='.',s[++n]=*r,s[++n]=0;R s;} 21 | 22 | Z C*afi(s)C *s;{Z C ap[]=".:/usr/local/a+/lib:/usr/local/lib/a:/common/a:/u/a"; 23 | C *t,*r=pfind("APATH",ap,s,R_OK); 24 | if(!r)t=fi(s,"+a"),r=pfind("APATH",ap,t,R_OK); 25 | if(!r)t=fi(s,"a"),r=pfind("APTATH",ap,t,R_OK); 26 | R r;} 27 | 28 | Z C*mfi(s,i)C *s;{C *t=fi(s,"m"),j=R_OK|(i?W_OK:0),*r=pfind("MPATH",".",t,j); 29 | if(!r)r=pfind("MPATH",".",s,j);if(!r)perr(t);R r;} 30 | 31 | C *doloadafile(s,u) C *s;{ /*silent version loadafile */ 32 | C r[MAXPATHLEN],*t=afi(s); 33 | CX x=Cx; I m=APL,c; FILE *f; 34 | if(!t)R (C *)0; 35 | if(!(f=fopen(t,"r")))R (C *)0; 36 | if ('#'==fgetc(f)&&'!'==fgetc(f)) while (EOF!=(c=fgetc(f))&&'\n'!=c); 37 | else rewind(f); 38 | if(u)unlink(t); 39 | gwd(r),APL=1,rf(u?0:s,f),Cx=x,APL=m,fclose(f),chdir(r);R strdup(t);} 40 | 41 | loadafile(s,u) C *s;{ /* now a cover for doloadafile */ 42 | I rc=(I)doloadafile(s,u); 43 | if (0==rc)R perr(s);else free((void *) rc); 44 | R 0;} 45 | 46 | ai(n){sgi();mi();wi();if(!tmp(n<<20))R 0;ki();yInstall();nsfInstall();R 1;} 47 | mpi(s,i)C *s;{I z;C *t;Q(!s||i<0||i<2||!(t=mfi(s,i&1)),9) 48 | ERR(t,z=open(t,i&1?O_RDWR:O_RDONLY))R nmap(z,i);} 49 | Z pw(f,s,n)C *s;{I t;do t=write(f,s,n);while(s+=t,t!=-1&&(n-=t));fsync(f);R t;} /* IBM write fix */ 50 | Z mo(s,z)A z;C *s;{I f,t=z->t,c,n;C r[MAXPATHLEN],*p;Q(Ctrindex(s,'/')?s:fi(s,"m"); 52 | strcpy(r,s),strcat(r,"!@#"); 53 | ERR(s,f=open(r,O_CREAT|O_WRONLY,0666)) 54 | if(c=z->c)z->i=z->r?*z->d:1; 55 | if(t=pw(f,z,n=AH+T(z->n)+(t==Ct)),c)z->c=c; 56 | close(f);ERR(s,t)ERR(s,t)ERR(s,rename(r,s))R 1;} 57 | C *cs(a)A a;{I s;R a->t==Ct?(C*)a->p:a->t==Et&&QS(s=*a->p)?XS(*a->p)->n:0;} 58 | H1(bi){R mpi(cs(a),0);}H2(bo){I n;C *s=cs(a);R !s?mpi(cs(w),*a->p):mo(s,w)?nl:0;} 59 | Z fzr(f,n){I j=getpagesize(),k=lseek(f,0,2);n=((n+j-1)/j)*j; 60 | for(;nj)j=m;if(w){t=a.t;if(n==-2)fzr(f,AH+T(a.n)+(t==Ct));else{ 64 | a.i=n,m=n*tr(a.r-1,a.d+1);if(n<*a.d)*a.d=n,a.n=m;lseek(f,0,0); 65 | ERR(s,write(f,&a,AH))ERR(s,flen(f,AH+T(m)+(t==Ct)))}}R close(f),j;} 66 | Z rd(f,s,n)C *s;{C *t=s+n;I k;for(;sp,t; 68 | Q(AH!=read(d,&b,AH)||b.t>Ct||b.r>MAXR||b.n!=tr(b.r,b.d),9) 69 | W(gd(t=b.t,&b))R rd(d,z->p,T(b.n))?(I)z:(dc(z),0);}} 70 | Z vf(a,b,i)C *a,*b;{A z;V v;I f,t;FILE g,*h; 71 | if(!isal(*a)||!b)R H("incorrect\n");v=vi(si(a),Cx);switch(i){ 72 | case 3:if(h=popen(b,"w"))g=*stdout,*stdout=*h,pa(gt(v)),NL,*h=*stdout,pclose(h),*stdout=g;else perr("pipe?");R; 73 | case 2:if(!QA(z=(A)v->a)||!z||!mo(b,z))R H("can't write%s\n",a);}dc(v->a),v->a=mi(b,1);} 74 | Z lst(n,s)C *s;{I i;CX x=*s?cx(s):Cx;V v; 75 | for(i=0;iht->nb;++i)for(v=x->ht->b[i];v;v=v->v) 76 | if(-1==n&&v->e||v->t==n&&v->a)pv(v);NL;} 77 | Z pcx(cx)CX cx;{H(" %s",cx->s->n);} 78 | Z cxs(){CX cx=Rx;for(;cx=cx->n;)pcx(cx);NL;} 79 | #define EX(a) dc(v->a),v->a=0 80 | exx(v)V v;{R v->o?0:(EX(a),EX(f),EX(c),EX(p),EX(q),EX(cd),EX(rff),EX(rfc), 81 | EX(rpf),EX(rpc),EX(scd),rmd(v),dst(v));} 82 | Z expunge (v)V v;{if (v->o) H("%s: is bound\n",v->s->n); else exx(v);} 83 | C *cmdsList[]={"vars","fns", "ops","xfs","si","wa", "cx", "rl", "load", "cd", 84 | "off", "mode","cxs","ex", "pp","sfs","stop","vers","loadrm","cmds", 85 | "def", "dep", "Tf", "Sf", "Xf","Df", "Gf", "deps","Ef", "_sfs", 86 | "dbg", 0}; 87 | Z C *ts[]={"0 off","1 on" "2 trace"}; 88 | #define CF(i,f) CS(i,if(*s)R f=*s=='s'?2:*s=='1';H("%s\n",ts[f]);) 89 | sys(s)C *s;{C *v;S t;C c,d,*u,*w,*x;I f=0;A a;V q; 90 | v=strdup(s); s=cl(u=bl(v)),c=*u,*u=0,x=cl(w=bl(s)),d=*w,*w=0; 91 | switch(*v){case '|':++f,*w=d;case '>':++f;case '*':++f;case '<':vf(v+1,s,f); 92 | free(v);R;} 93 | switch(lu(v,cmdsList)){CS(16,xfs())CS(30,x_fs())CS(11,exit(0))CS(13,cxs())CS(9,loadafile(s,0)) 94 | CS(1,lst(0,s))CS(2,lst(1,s))CS(3,lst(2,s);lst(3,s);lst(4,s))CS(4,lst(5,s)) 95 | CS(5,--K;sik();NL;++K)CS(6,wa(!*s?-1:*s=='-'?-2:atoi(s))) 96 | CS(7,if(*s)Cx=cx(s);else H("%s\n",Cx==Rx?".":Cx->s->n)) 97 | CS(8,srandom(atoi(s)))CS(10,PERR(s,chdir(*s?s:getenv("HOME")));setPWD();) 98 | CS(12,if(*s)R APL=s[1]=='p';H(APL?"apl\n":"ascii\n");) 99 | CS(14,for(;*s;*w=d,w=bl(s=cl(w)),d=*w,*w=0)expunge(sv(Cx,si(s)))) 100 | CS(15,if(!*s||!isdi(*s)||s[1]&&!isdi(s[1]))R H("%c%c\n",Fs[3],Fs[4]);Fs[3]=s[1]?*s++:'0';Fs[4]=*s) 101 | CF(17,sq)CS(18,H("%p\n",(a=versGet())->p);dc(a))CS(19,loadafile(s,1)) 102 | CS(21,f0(s))CS(22,f1(s))CF(24,Sf)CF(25,Xf)CF(26,Df)CF(27,Gf)CF(29,Ef) 103 | CS(31,dbg(s,x)) 104 | CS(23,Tf=0;disable()) CS(20,for(;cmdsList[f];++f)H(" %s",cmdsList[f]);NL) 105 | CS(28,lst(-1,s)) 106 | default:*u=c,*w=d;syst(v);}free(v);R;} 107 | Z H1(c_i){A z;Q(a->t!=Ct&&a->n,6)W(gd(It,a))DO(a->n,z->p[i]=((UC*)a->p)[i])R(I)z;} 108 | Z H1(i_c){A z;Q(a->t!=It&&a->n,6)W(gd(Ct,a))DO(a->n,((C*)z->p)[i]=a->p[i])R(I)z;} 109 | H1(i_f){A z;Q(a->t!=It&&a->n,6)W(gd(Ft,a))DO(a->n,((F*)z->p)[i]=a->p[i])R(I)z;} 110 | Z H1(f_j){A z;F f;Q(a->t!=Ft&&a->n,6)W(gd(It,a))DO(a->n,z->p[i]=(f=((F*)a->p)[i])>0?f+.5:f-.5)R(I)z;} 111 | Z H1(f_i){A z;F f;I d;Q(a->t!=Ft&&a->n,6)W(gd(It,a))DO(a->n,f=((F*)a->p)[i]; 112 | if(d=f>0?f+.5:f-.5,(f>d?f-d:d-f)>=CT*(f>1?f:f>-1?-f:1))R(q=6,dc(z),0);z->p[i]=d)R(I)z;} 113 | A ci(i){I z;A a=(A)Y[i];R(A)((z=f_i(a))?(dc(a),Y[i]=z):0);} 114 | A ep_cf(i){I z;A a=(A)Y[i];R(A)((z=i_f(a))?(dc(a),Y[i]=z):0);} 115 | H2(cv){A z;I u,t=w->t;C c;if(a->t!=Et)R ds(a,w,1);Q(!QS(*a->p),9) 116 | Q(t>Ct&&w->n||a->n!=1,9)c=*XS(*a->p)->n;u=c=='i'?It:c=='f'?Ft:Ct; 117 | R u==t?ic(w):!u?(t==Ft?f_j(w):c_i(w)):t&&w->n?(q=6,0):u==Ft?i_f(w):i_c(w);} 118 | H1(c_s){A z;XA;C *s=(C*)a->p;I n,j;Q(a->t!=Ct,6)!ar?(*ad=1):--ar;W(ga(Et,ar,n=tr(ar,ad),ad))an=ad[ar]; 119 | DO(n,for(j=an;j--&&s[j]==' ';);z->p[i]=MS(si(sj(s,j+1)));s+=an)R(I)z;} 120 | H1(s_c){A z;XA;I k;int m=0;C *s; 121 | Q(an&&!sym(a),6)DO(an,if(m<(k-strlen(XS(a->p[i])->n)))m=k)W(ga(Ct,ar+a,an+m,ad))z->d[ar]=m;s=(C*)z->p; 122 | DO(an,sprintf(s,"%-*s",m,XS(a->p[i])->n);s+=m)R(I)z;} 123 | I cn(i,t){I a=Y[i],z=(I)gd(t,a);R dc(a),Y[i]=z;} 124 | void yInstall(){install(items,"_items",9,2,9,0);R;} 125 | -------------------------------------------------------------------------------- /a/z.c: -------------------------------------------------------------------------------- 1 | #include "f.h" 2 | dot(){} 3 | undot(){} 4 | dbg(){} 5 | trc(){} 6 | I dbg_tf,dbg_depth; 7 | pck(i,a)A a;{I z;I t=a->t;R t==Et&&(z=a->p[i],!QF(z))?ic(z):(I)gc(t,0.1,0,(C*)a->p+T(i));} 8 | Z pchk(n,a)A a;{Q(a->r>1,7)Q(a->t!=Et||fsy(a),6)Q((unsigned)n>=a->n,10)R(I)(a->p+n);} 9 | Z pick(a,d,b)A a;I *b;{I *p;R!d?(I)a:(p=(I*)pchk(*b,a))?pick(*p,d-1,b+1):0;} 10 | Z ass(a)A a;{A s=(A)*a->p,d=(A)a->p[1];R a->t==Et&&a->n==2&&QA(s)&&QA(d)&& 11 | sym(s)&&s->n==d->n&&s->r<2&&d->r<2&&d->t==Et&&!fsy(d);} 12 | Z spck(s,a)A a;{A w=(A)*a->p;Q(!ass(a),9)DO(w->n,if(w->p[i]==s)R i)R q=10,0;} 13 | Z spick(a,w)A a,w;{I i;Q(a->r,7)R i=spck(*a->p,w),q?0:pck(i,w->p[1]);} 14 | H2(pic){if(sym(a))R spick(a,w);I1 if(a->r)R(a=(A)pick(w,a->n,a->p))?ic(a):0; 15 | Q(w->r!=1,7)Q((unsigned)*a->p>=w->n,10)R pck(*a->p,w);} 16 | Z pk0(v,d,b)I *b;{R!d?v:(v=pchk(*b,un(v)))?pk0(v,d-1,b+1):0;} 17 | pka(p,v)A p,*v;{if(sym(p)){Z b[2]={1};b[1]=spck(*p->p,*v);R q?0:pk0(v,2,b);} 18 | Q(p->r>1,7)Q(p->t,6)R pk0(v,p->n,p->p);} 19 | 20 | /* 21 | H2 (pk){unsigned j,d,k;A p;Q(a->t!=Et,6)Q(a->r>1,7)DO(a->n,p=a->p[i]; 22 | Q(p->t||w->t!=Et,6)Q(p->r>1||p->n!=w->r,7)k=0; 23 | DO(p->n,j=p->p[i];d=w->d[i];Q(j>=d,10)k=k*d+j)w=w->p[k]) 24 | R ic(w);} 25 | 26 | if(z=(I*)v,p)if(!sym(p)){if(z=(I*)pk0(v,p->n,p->p),!z)R 0;} 27 | else{*b=1,b[1]=spck(*p->p,*z);if(q)R 0;z=(I*)pk0(v,2,b);} 28 | 29 | */ -------------------------------------------------------------------------------- /dap/Warn.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_Warn_h 2 | #define included_dap_Warn_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | 13 | /* header file inclusions */ 14 | #include 15 | #if defined(__STDC__) || defined(__cplusplus) || defined(_AIX) 16 | #include 17 | #endif 18 | 19 | /* external data declarations */ 20 | extern char _ErrBuf[]; 21 | 22 | /* external function declarations */ 23 | #if defined(__STDC__) || defined(__cplusplus) || defined(_AIX) 24 | # ifdef __cplusplus 25 | extern "C" { 26 | # endif 27 | extern void vWarn(char *,va_list); 28 | extern void Warn(char*,...); 29 | extern void Abort(char*,...); 30 | extern void Panic(char*,...); 31 | extern void Exit(int, char*,...); 32 | extern void SetWarn(char*); 33 | extern void SetWarnFP(FILE*); 34 | extern void SetWarnFunc(void (*f)(char *)); 35 | # ifdef __cplusplus 36 | } 37 | # endif 38 | #else 39 | extern void Warn(); 40 | extern void Abort(); 41 | extern void Panic(); 42 | extern void Exit(); 43 | extern void SetWarn(); 44 | extern void SetWarnFP(); 45 | extern void SetWarnFunc(); 46 | #endif 47 | 48 | 49 | #endif 50 | 51 | -------------------------------------------------------------------------------- /dap/args.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_args_h 2 | #define included_dap_args_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | /* args functions assume that argc and argv will not be altered 13 | * while processing the arguments, thus the check for empty list 14 | * or null arguments only occurs at the start of processing of a 15 | * given list or argument. 16 | */ 17 | 18 | 19 | /* external data declarations */ 20 | extern int args_argpos; 21 | extern int args_index; 22 | extern char *args_value; 23 | 24 | /* external function declarations */ 25 | #if defined(__STDC__) || defined(__cplusplus) || defined(_AIX) 26 | # ifdef __cplusplus 27 | extern "C" { 28 | # endif 29 | extern int argsfirst(int, char**); 30 | extern int argsgetopt(int, char**,char *); 31 | extern void argsnext(int, char**); 32 | # ifdef __cplusplus 33 | } 34 | # endif 35 | #else 36 | extern int argsfirst(); 37 | extern int argsgetopt(); 38 | extern void argsnext(); 39 | #endif 40 | 41 | #endif 42 | 43 | -------------------------------------------------------------------------------- /dap/args_data.c: -------------------------------------------------------------------------------- 1 | /*****************************************************************************/ 2 | /* */ 3 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 4 | /* See .../src/LICENSE for terms of distribution. */ 5 | /* */ 6 | /* */ 7 | /*****************************************************************************/ 8 | /* contributed by Daniel F. Fisher */ 9 | 10 | /* external data definitions */ 11 | int args_argpos; 12 | int args_index; 13 | char *args_value; 14 | -------------------------------------------------------------------------------- /dap/argsfirst.c: -------------------------------------------------------------------------------- 1 | /*****************************************************************************/ 2 | /* */ 3 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 4 | /* See .../src/LICENSE for terms of distribution. */ 5 | /* */ 6 | /* */ 7 | /*****************************************************************************/ 8 | /* contributed by Daniel F. Fisher */ 9 | 10 | /* 11 | * argsfirst initializes the variables used by other functions in processing 12 | * the argument list. It sets args_value to be argv[0] and returns zero. If 13 | * the argument list is empty, it returns -1 and sets args_value to be null. 14 | */ 15 | 16 | /* header file inclusions */ 17 | #include 18 | 19 | /* external function definitions */ 20 | int 21 | argsfirst(int argc, char **argv) 22 | { 23 | /* initalize argument processing variables */ 24 | args_index = 0; 25 | args_argpos = 0; 26 | args_value = (char *) (0); 27 | 28 | /* check for empty list */ 29 | if ((argv == (char **) (0)) 30 | || (args_index >= argc)) { 31 | /* empty argument list */ 32 | return -1; 33 | } 34 | /* process argv[0] */ 35 | args_value = argv[0]; 36 | argsnext(argc, argv); 37 | return 0; 38 | } 39 | -------------------------------------------------------------------------------- /dap/argsgetopt.c: -------------------------------------------------------------------------------- 1 | /*****************************************************************************/ 2 | /* */ 3 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 4 | /* See .../src/LICENSE for terms of distribution. */ 5 | /* */ 6 | /* */ 7 | /*****************************************************************************/ 8 | /* contributed by Daniel F. Fisher */ 9 | 10 | /* 11 | * argsgetopt - this similar to getopt(3) except that it 1) never prints an 12 | * error message; 2) always returns the actual option letter found, relying 13 | * on the user to handle unknown options in the default case of a switch 14 | * statement; 3) treats unknown options as though they had an argument (to 15 | * avoid cascaded errors); 4) Sets args_value to null when no argument can be 16 | * found; 5) Null arguments are skipped. 17 | */ 18 | 19 | /* header file inclusions */ 20 | #include 21 | #include 22 | #include 23 | 24 | /* external function definitions */ 25 | int 26 | argsgetopt(int argc, char **argv, char *opts) 27 | { 28 | int c; 29 | char *cp; 30 | 31 | if (args_index == 0) { 32 | /* 33 | * args_first never called or it detected empty list, call it and if it 34 | * returns -1, return -1, indicating that there are no options. 35 | */ 36 | if (argsfirst(argc, argv) == -1) { 37 | return -1; 38 | } 39 | } 40 | if (args_argpos == 0) { 41 | if (args_index >= argc) { 42 | return -1; 43 | } 44 | /* begin processing new argument */ 45 | if ((argv[args_index][0] != '-') 46 | || (argv[args_index][1] == '\0')) { 47 | /* new argument is first after options */ 48 | return -1; 49 | } 50 | if (argv[args_index][1] == '-') { 51 | /* new argument is end of options marker, "--" */ 52 | argsnext(argc, argv); 53 | return -1; 54 | } 55 | args_argpos = 1; 56 | } 57 | if (((c = argv[args_index][args_argpos++]) == ':') 58 | || ((cp = (char *) strchr((DEV_STRARG) opts, c)) == 0) 59 | || (*++cp == ':')) { 60 | /* unknown option or option with argument */ 61 | if (argv[args_index][args_argpos] != '\0') { 62 | /* option argument follows immediately */ 63 | args_value = &argv[args_index][args_argpos]; 64 | argsnext(argc, argv); 65 | } else if (argsnext(argc, argv), args_index >= argc) { 66 | /* no option argument */ 67 | args_value = (char *) (0); 68 | } else { 69 | /* option argument is nex* argument */ 70 | args_value = argv[args_index]; 71 | argsnext(argc, argv); 72 | } 73 | } else { 74 | /* good option without argument */ 75 | if (argv[args_index][args_argpos] == '\0') { 76 | argsnext(argc, argv); 77 | } 78 | args_value = (char *) (0); 79 | } 80 | return c; 81 | } 82 | -------------------------------------------------------------------------------- /dap/argsnext.c: -------------------------------------------------------------------------------- 1 | /*****************************************************************************/ 2 | /* */ 3 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 4 | /* See .../src/LICENSE for terms of distribution. */ 5 | /* */ 6 | /* */ 7 | /*****************************************************************************/ 8 | /* contributed by Daniel F. Fisher */ 9 | 10 | /* header file inclusions */ 11 | #include 12 | 13 | /* external function definitions */ 14 | void 15 | argsnext(int argc, char **argv) 16 | { 17 | /* skip past null arguments */ 18 | while (args_index < argc) { 19 | if (argv[++args_index] != (char *) (0)) { 20 | break; 21 | } 22 | } 23 | 24 | /* zero position within argument */ 25 | args_argpos = 0; 26 | 27 | return; 28 | } 29 | -------------------------------------------------------------------------------- /dap/avl.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_avl_h 2 | #define included_dap_avl_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | 13 | /* external macro declarations */ 14 | 15 | /* avlwalk() type codes */ 16 | #define AVLWALK_PREORDER (0) 17 | #define AVLWALK_INORDER (2) 18 | #define AVLWALK_POSTORDER (4) 19 | #define AVLWALK_LEAF (6) 20 | #define AVLWALK_ALL (8) 21 | #define AVLWALK_REVERSE (1) 22 | 23 | /* external struct, union, typedef and enum declarations */ 24 | 25 | /* avl tree node */ 26 | struct avln 27 | { 28 | struct avln *l; /* left pointer */ 29 | struct avln *r; /* right pointer */ 30 | int bal; /* balancing: Height(left) - Height(right) */ 31 | void *d; /* user data (including key and value) */ 32 | }; 33 | 34 | /* avl tree search structure */ 35 | struct avl 36 | { 37 | struct avln *root; /* pointer to root node of avl tree */ 38 | void *(*key)(); /* extract key portion */ 39 | void *(*value)(); /* extract value portion */ 40 | int (*compare)(); /* key comparison function */ 41 | void *(*insert)(); /* insertion notification */ 42 | void *(*replace)(); /* replacement notification */ 43 | void (*remove)(); /* removal notification */ 44 | }; 45 | 46 | /* external function declarations */ 47 | #if defined(__STDC__) || defined(__cplusplus) || defined(_AIX) 48 | # ifdef __cplusplus 49 | extern "C" { 50 | # endif 51 | extern struct avl *avlalloc(void *(*)(), 52 | void *(*)(), 53 | int (*)(), 54 | void *(*)(), 55 | void *(*)(), 56 | void (*)() 57 | ); 58 | extern void *avlfind(struct avl *,void *); 59 | extern void avlfree(struct avl *); 60 | extern void *avlinsert(struct avl *,void *,void *); 61 | extern void *avlremove(struct avl *,void *); 62 | extern void *avlreplace(struct avl *,void *,void *); 63 | extern void *avlwalk(struct avl *,int,void *(*)(),void *); 64 | # ifdef __cplusplus 65 | } 66 | # endif 67 | #else 68 | extern struct avl *avlalloc(); 69 | extern void *avlfind(); 70 | extern void avlfree(); 71 | extern void *avlinsert(); 72 | extern void *avlremove(); 73 | extern void *avlreplace(); 74 | extern void *avlwalk(); 75 | #endif 76 | #endif 77 | 78 | 79 | 80 | 81 | 82 | -------------------------------------------------------------------------------- /dap/balloc.c: -------------------------------------------------------------------------------- 1 | /*****************************************************************************/ 2 | /* */ 3 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 4 | /* See .../src/LICENSE for terms of distribution. */ 5 | /* */ 6 | /* */ 7 | /*****************************************************************************/ 8 | /* contributed by Daniel F. Fisher */ 9 | 10 | /* header file inclusions */ 11 | #if defined(__NetBSD__) || defined(__FreeBSD) || defined (__APPLE__) || defined (linux) 12 | #include 13 | #else 14 | #include 15 | #endif 16 | 17 | #include 18 | #include 19 | #include 20 | #include 21 | #include 22 | 23 | /* internal function declarations */ 24 | static void gasp(int size); 25 | 26 | /* external function definitions */ 27 | void * 28 | balloc(int size) 29 | { 30 | static char fnc[] = "balloc"; 31 | void *p; 32 | 33 | if (size <= 0) { 34 | return (void *) (0); 35 | } 36 | if ((p = (void *) malloc((unsigned) size)) == (void *) (0)) { 37 | if (errno == ENOMEM) { 38 | /* GASP!!!! */ 39 | gasp(size); 40 | _Exit(1); 41 | } 42 | Abort("%t %s(): abort: malloc(%u): %m\n", fnc, (unsigned) size); 43 | } 44 | return p; 45 | } 46 | 47 | /* internal function definitions */ 48 | static void 49 | gasp(int size) 50 | { 51 | static char m0[] = "\nballoc("; 52 | static char m1[ULTODEC_SZ]; 53 | int z1; 54 | static char m2[] = "): "; 55 | #ifdef HAVE_STRERROR 56 | char *m3 = strerror(ENOMEM); 57 | #else 58 | char *m3 = sys_errlist[ENOMEM]; 59 | #endif 60 | int z3 = strlen(m3); 61 | static char m4[] = "\n\n"; 62 | 63 | z1 = ultodec((unsigned long) size, m1, ULTODEC_SZ) - 1; 64 | 65 | (void) write(2, m0, sizeof(m0) - 1); 66 | (void) write(2, m1, z1); 67 | (void) write(2, m2, sizeof(m2) - 1); 68 | (void) write(2, m3, z3); 69 | (void) write(2, m4, sizeof(m4) - 1); 70 | 71 | return; 72 | } 73 | -------------------------------------------------------------------------------- /dap/balloc.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_balloc_h 2 | #define included_dap_balloc_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | 13 | #include 14 | 15 | /* extern macro declarations */ 16 | #define bnew(t) (t *)balloc(sizeof(t)) 17 | #define bnew_r(t) (t *)balloc_r(sizeof(t)) 18 | 19 | /* external function declarations */ 20 | #if defined(__STDC__) || defined(__cplusplus) || defined(_AIX) 21 | # ifdef __cplusplus 22 | extern "C" { 23 | # endif 24 | extern char *bgprintf(int, char *, ...); 25 | extern char *bnstring(char *, ...); 26 | extern char *bnstring_r(char *, ...); 27 | extern char *bstring(const char *); 28 | extern char *bstring_r(char *); 29 | extern int bstrhash(char *); 30 | extern void *balloc(int); 31 | extern void *balloc_r(int); 32 | extern void *bdup(void *, int); 33 | extern void *bdup_r(void *, int); 34 | extern void *brealloc(char *, int); 35 | extern void *brealloc_r(char *, int); 36 | extern void bfree(char *); 37 | # ifdef __cplusplus 38 | } 39 | # endif 40 | #else 41 | extern char *bgprintf(); 42 | extern char *bnstring(); 43 | extern char *bnstring_r(); 44 | extern char *bstring(); 45 | extern char *bstring_r(); 46 | extern int bstrhash(); 47 | extern void *balloc(); 48 | extern void *balloc_r(); 49 | extern void *bdup(); 50 | extern void *bdup_r(); 51 | extern void *brealloc(); 52 | extern void *brealloc_r(); 53 | extern void bfree(); 54 | #endif 55 | #endif 56 | -------------------------------------------------------------------------------- /dap/bfree.c: -------------------------------------------------------------------------------- 1 | /*****************************************************************************/ 2 | /* */ 3 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 4 | /* See .../src/LICENSE for terms of distribution. */ 5 | /* */ 6 | /* */ 7 | /*****************************************************************************/ 8 | /* contributed by Daniel F. Fisher */ 9 | 10 | #include 11 | 12 | /* external function definitions */ 13 | void 14 | bfree(char *p) 15 | { 16 | if (p != (char *) (0)) { 17 | free(p); 18 | } 19 | return; 20 | } 21 | -------------------------------------------------------------------------------- /dap/brealloc.c: -------------------------------------------------------------------------------- 1 | /*****************************************************************************/ 2 | /* */ 3 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 4 | /* See .../src/LICENSE for terms of distribution. */ 5 | /* */ 6 | /* */ 7 | /*****************************************************************************/ 8 | /* contributed by Daniel F. Fisher */ 9 | 10 | /* header file inclusions */ 11 | #if defined(__NetBSD__) || defined(__FreeBSD) || defined (__APPLE__) 12 | #include 13 | #else 14 | #include 15 | #endif 16 | 17 | #include 18 | #include 19 | #include 20 | #include 21 | #include 22 | 23 | /* internal function definitions */ 24 | static void gasp(char *p, int size); 25 | 26 | /* external function definitions */ 27 | void * 28 | brealloc(char *p, int size) 29 | { 30 | static char fnc[] = "brealloc"; 31 | char *p0 = p; 32 | 33 | if (p == (char *) (0)) { 34 | return balloc(size); 35 | } 36 | if (size <= 0) { 37 | bfree(p); 38 | return (void *) (0); 39 | } 40 | if ((p = realloc(p, (unsigned) size)) == (char *) (0)) { 41 | if (errno == ENOMEM) { 42 | /* GASP!!!! */ 43 | gasp(p0, size); 44 | _Exit(1); 45 | } 46 | Abort("%t %s(): abort: realloc(%u): %m\n", fnc, (unsigned) size); 47 | } 48 | return (void *) p; 49 | } 50 | 51 | /* internal function definitions */ 52 | static void 53 | gasp(char *p, int size) 54 | { 55 | static char m0[] = "\nbrealloc(0x"; 56 | static char m1[ULTOHEX_SZ]; 57 | int z1; 58 | static char m2[] = ", "; 59 | static char m3[ULTODEC_SZ]; 60 | int z3; 61 | static char m4[] = "): "; 62 | #ifdef HAVE_STRERROR 63 | char *m5 = strerror(ENOMEM); 64 | #else 65 | char *m5 = sys_errlist[ENOMEM]; 66 | #endif 67 | int z5 = strlen(m5); 68 | static char m6[] = "\n\n"; 69 | 70 | z1 = ultohex((unsigned long) p, m1, ULTOHEX_SZ) - 1; 71 | z3 = ultodec((unsigned long) size, m3, ULTODEC_SZ) - 1; 72 | 73 | (void) write(2, m0, sizeof(m0) - 1); 74 | (void) write(2, m1, z1); 75 | (void) write(2, m2, sizeof(m2) - 1); 76 | (void) write(2, m3, z3); 77 | (void) write(2, m4, sizeof(m4) - 1); 78 | (void) write(2, m5, z5); 79 | (void) write(2, m6, sizeof(m6) - 1); 80 | 81 | return; 82 | } 83 | -------------------------------------------------------------------------------- /dap/buff.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_buff_h 2 | #define included_dap_buff_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | #include 13 | 14 | 15 | /* external macro declarations */ 16 | #define BUFFAT(np) ((struct buff *)((np)->d)) 17 | 18 | /* external struct, union, typedef and enum declarations */ 19 | struct buff 20 | { 21 | int inc; /* This member is going away */ 22 | int ref; 23 | char *min; 24 | char *get; 25 | char *put; 26 | char *max; 27 | }; 28 | 29 | /* external function declarations */ 30 | #if defined(__STDC__) || defined(__cplusplus) || defined(_AIX) 31 | # ifdef __cplusplus 32 | extern "C" { 33 | # endif 34 | extern struct buff *buffalloc(void); 35 | extern struct buff *buffalloc_r(void); 36 | extern void buffclear(struct buff *p); 37 | extern struct buff * bufffrag(struct buff *p, int frag); 38 | extern void bufffree(struct buff *p); 39 | extern int buffgetc(struct buff *p); 40 | extern void buffgprintf(struct buff *p, int size, char *fmt, ...); 41 | extern void buffputc(struct buff *p, char c); 42 | extern int buffputc_r(struct buff *p, char c); 43 | extern void buffputdouble(struct buff *p, double d); 44 | extern void buffputint(struct buff *p, int d); 45 | extern void buffputlong(struct buff *p, long d); 46 | extern void buffputs(struct buff *p, char *s); 47 | extern void buffputshort(struct buff *p, short d); 48 | extern int buffread(struct buff *p, int fd, int len); 49 | extern struct buff * buffref(struct buff *p); 50 | extern void buffroom(struct buff *p, int room); 51 | extern int buffroom_r(struct buff *p, int room); 52 | extern void buffstuff(struct buff *p, char *value, int size); 53 | extern int buffstuff_r(struct buff *p, char *value, int size); 54 | extern void bufftrim(struct buff *p); 55 | extern int buffwrite(struct buff *p, int fd, int len); 56 | extern void buffzero(struct buff *p, int size); 57 | # ifdef __cplusplus 58 | } 59 | # endif 60 | #else 61 | extern struct buff *buffalloc(); 62 | extern struct buff *buffalloc_r(); 63 | extern void buffclear(); 64 | extern struct buff * bufffrag(); 65 | extern void bufffree(); 66 | extern int buffgetc(); 67 | extern void buffgprintf(); 68 | extern void buffputc(); 69 | extern int buffputc_r(); 70 | extern void buffputdouble(); 71 | extern void buffputint(); 72 | extern void buffputlong(); 73 | extern void buffputs(); 74 | extern void buffputshort(); 75 | extern int buffread(); 76 | extern struct buff * buffref(); 77 | extern void buffroom(); 78 | extern int buffroom_r(); 79 | extern void buffstuff(); 80 | extern int buffstuff_r(); 81 | extern void bufftrim(); 82 | extern int buffwrite(); 83 | extern void buffzero(); 84 | #endif 85 | 86 | #endif 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | -------------------------------------------------------------------------------- /dap/buffalloc.c: -------------------------------------------------------------------------------- 1 | /*****************************************************************************/ 2 | /* */ 3 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 4 | /* See .../src/LICENSE for terms of distribution. */ 5 | /* */ 6 | /* */ 7 | /*****************************************************************************/ 8 | /* contributed by Daniel F. Fisher */ 9 | 10 | /* header file inclusions */ 11 | #include 12 | #include 13 | 14 | /* external function definitions */ 15 | struct buff * 16 | buffalloc(void) 17 | { 18 | struct buff *p; 19 | 20 | p = (struct buff *) balloc(sizeof(*p)); 21 | p->ref = 1; 22 | p->min = p->get = p->put = p->max = (char *) (0); 23 | return p; 24 | } 25 | -------------------------------------------------------------------------------- /dap/buffputlong.c: -------------------------------------------------------------------------------- 1 | /*****************************************************************************/ 2 | /* */ 3 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 4 | /* See .../src/LICENSE for terms of distribution. */ 5 | /* */ 6 | /* */ 7 | /*****************************************************************************/ 8 | /* contributed by Chuck Ocheret */ 9 | 10 | /* header file inclusions */ 11 | #include 12 | 13 | /* external function definitions */ 14 | void 15 | buffputlong(struct buff * p, long int d) 16 | { 17 | buffstuff(p, (char *) (&d), sizeof(d)); 18 | return; 19 | } 20 | -------------------------------------------------------------------------------- /dap/buffroom.c: -------------------------------------------------------------------------------- 1 | /*****************************************************************************/ 2 | /* */ 3 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 4 | /* See .../src/LICENSE for terms of distribution. */ 5 | /* */ 6 | /* */ 7 | /*****************************************************************************/ 8 | /* contributed by Daniel F. Fisher */ 9 | 10 | /* header file inclusions */ 11 | #include 12 | #include 13 | #include 14 | 15 | /* external function definitions */ 16 | void 17 | buffroom(struct buff * p, int add) 18 | { 19 | int def; /* space deficiency */ 20 | 21 | if ((p != (struct buff *) (0)) 22 | && ((def = add - (p->max - p->put)) > 0)) { 23 | int len = p->put - p->get; 24 | int off = p->get - p->min; 25 | 26 | if (def > off) { 27 | /* deficiency is more than the offset */ 28 | int siz = p->max - p->min; 29 | int req = siz + def; 30 | 31 | siz += siz / 2; 32 | if (siz < req) 33 | siz = req; 34 | if (siz < sizeof(*p)) 35 | siz = sizeof(*p); 36 | p->min = (char *) brealloc(p->min, siz); 37 | p->get = p->min + off; 38 | p->put = p->get + len; 39 | p->max = p->min + siz; 40 | } else { 41 | bcopy(p->get, p->min, len); 42 | p->get -= off; 43 | p->put -= off; 44 | } 45 | } 46 | return; 47 | } 48 | -------------------------------------------------------------------------------- /dap/buffstuff.c: -------------------------------------------------------------------------------- 1 | /*****************************************************************************/ 2 | /* */ 3 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 4 | /* See .../src/LICENSE for terms of distribution. */ 5 | /* */ 6 | /* */ 7 | /*****************************************************************************/ 8 | /* contributed by Daniel F. Fisher */ 9 | 10 | /* header file inclusions */ 11 | #include 12 | #include 13 | #include 14 | 15 | /* external function definitions */ 16 | void 17 | buffstuff(struct buff * p, char *value, int size) 18 | { 19 | if ((p != (struct buff *) (0)) 20 | && (size > 0)) { 21 | if (p->max - p->put < size) { 22 | buffroom(p, size); 23 | } 24 | bcopy(value, p->put, size); 25 | p->put += size; 26 | } 27 | return; 28 | } 29 | -------------------------------------------------------------------------------- /dap/chan.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_chan_h 2 | #define included_dap_chan_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | 13 | /* header file inclusions */ 14 | #include 15 | #include 16 | #include 17 | 18 | /* external macro declarations */ 19 | #define CHANAT(np) ((struct chan *)((np)->d)) 20 | 21 | /* chanopen() channel type codes */ 22 | #define CHAN_R (0) 23 | #define CHAN_W (1) 24 | #define CHAN_X (2) 25 | 26 | /* chan priority values */ 27 | #define CHAN_PRI_HIGH INT_MAX 28 | #define CHAN_PRI_DFLT (0) 29 | #define CHAN_PRI_LOW INT_MIN 30 | 31 | /* external struct, union, typedef and enum declarations */ 32 | struct chan 33 | { 34 | char *name; /* channel name */ 35 | int pri; /* processing priority of channel */ 36 | struct node *np; /* scheduling node pointer */ 37 | fd_set *fds; /* enabled fd set */ 38 | fd_set *afds; /* available fd set */ 39 | int fd; /* channel file descriptor */ 40 | void (*func)(); /* processing function */ 41 | void *ccbp; /* channel control block */ 42 | }; 43 | 44 | /* external data declarations */ 45 | extern struct node chans; 46 | 47 | /* external function declarations */ 48 | #if defined(__STDC__) || defined(__cplusplus) || defined(_AIX) 49 | # ifdef __cplusplus 50 | extern "C" { 51 | # endif 52 | extern struct chan *chanopen( const char *,int,int,int, 53 | void (*)(void *), void * ); 54 | extern void chanclose( struct chan * ); 55 | extern void chandsbl( struct chan * ); 56 | extern void chanenbl( struct chan * ); 57 | extern int chanisdsbl( struct chan * ); 58 | extern int chanisenbl( struct chan * ); 59 | extern int chanproc(); 60 | extern void chansetpri( struct chan *, int); 61 | # ifdef __cplusplus 62 | } 63 | # endif 64 | #else 65 | extern struct chan *chanopen(); 66 | extern void chanclose(); 67 | extern void chandsbl(); 68 | extern void chanenbl(); 69 | extern int chanisdsbl(); 70 | extern int chanisenbl(); 71 | extern int chanproc(); 72 | extern void chansetpri(); 73 | #endif 74 | 75 | #endif 76 | 77 | -------------------------------------------------------------------------------- /dap/conn.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_conn_h 2 | #define included_dap_conn_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | 13 | /* header file inclusions */ 14 | #include 15 | #include 16 | #include 17 | #ifdef PRESUNOS4 18 | # ifndef _SOCKET_ 19 | # define _SOCKET_ 20 | # include 21 | # endif 22 | #else 23 | # include 24 | #endif 25 | #include 26 | #include 27 | #include 28 | 29 | 30 | /* external macro declarations */ 31 | 32 | /* conn retry values */ 33 | #define CONN_RETRY_NO (0) 34 | #define CONN_RETRY_YES (1) 35 | 36 | /* external struct, union, typedef and enum declarations */ 37 | struct conn 38 | { 39 | /* configuration information */ 40 | char *name; /* connection identification name */ 41 | int pri; /* connection establishment priority */ 42 | int retry; /* retry connection after failure */ 43 | int domain; /* socket address domain */ 44 | int type; /* socket type */ 45 | int protocol; /* socket protocol */ 46 | void *r_nameinfo; /* remote name information */ 47 | int (*setupfunc)(); /* user setup function */ 48 | struct sockaddr *(*r_namefunc)(); /* r_nameinfo to r_name */ 49 | int (*estbfunc)(); /* establishment notification func */ 50 | void *acb; /* application's control block */ 51 | 52 | /* state information */ 53 | struct exbo *retry_time; /* retry time limit with back-off */ 54 | struct timer *retry_tp; /* retry timer */ 55 | int fd; /* file descriptor */ 56 | int r_namelen; /* remote name length */ 57 | struct sockaddr *r_name; /* remote name */ 58 | struct chan *estbchan; /* connection establishment channel */ 59 | int estbd; /* established */ 60 | 61 | /* administrative information */ 62 | time_t alloctod; /* time connection was allocated */ 63 | time_t opentod; /* time connection was opened */ 64 | time_t conntod; /* time connection was attempted */ 65 | time_t estbtod; /* time connection was established */ 66 | time_t disctod; /* time connection was disconnected */ 67 | time_t closetod; /* time connection was closed */ 68 | time_t opendtime; /* seconds opened in prev instances */ 69 | time_t estbdtime; /* seconds estbd in prev instances */ 70 | unsigned opencount; /* number of times opened */ 71 | unsigned conncount; /* number of times connected */ 72 | unsigned estbcount; /* number of times established */ 73 | unsigned disccount; /* number of times disconnected */ 74 | unsigned closecount; /* number of times closed */ 75 | }; 76 | 77 | /* external function declarations */ 78 | #if defined(__STDC__) || defined(__cplusplus) || defined(_AIX) 79 | # ifdef __cplusplus 80 | extern "C" { 81 | # endif 82 | extern void connackestb(struct conn *); 83 | extern struct conn *connalloc( 84 | char *,int,int,int,int,int,int,int, 85 | void *, int (*)(),struct sockaddr *(*)(), 86 | int (*)(),void *); 87 | extern void connclose(struct conn *); 88 | extern void connfree(struct conn *); 89 | extern void connopen(struct conn *); 90 | # ifdef __cplusplus 91 | } 92 | # endif 93 | #else 94 | extern void connackestb(); 95 | extern struct conn *connalloc(); 96 | extern void connclose(); 97 | extern void connfree(); 98 | extern void connopen(); 99 | #endif 100 | 101 | #endif 102 | 103 | -------------------------------------------------------------------------------- /dap/dap.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_dap_h 2 | #define included_dap_dap_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | 13 | /* header file inclusions */ 14 | #include 15 | #include 16 | #include 17 | #include 18 | #include 19 | #include 20 | #include 21 | #include 22 | #include 23 | #include 24 | #include 25 | #include 26 | #include 27 | #include 28 | #include 29 | #include 30 | #include 31 | #include 32 | #include 33 | #include 34 | #include 35 | 36 | #endif 37 | 38 | -------------------------------------------------------------------------------- /dap/error.c: -------------------------------------------------------------------------------- 1 | /*****************************************************************************/ 2 | /* */ 3 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 4 | /* See .../src/LICENSE for terms of distribution. */ 5 | /* */ 6 | /* */ 7 | /*****************************************************************************/ 8 | 9 | #include 10 | #include 11 | #if defined(__cplusplus) 12 | #include 13 | #else 14 | #include 15 | #endif 16 | #if !defined(__cfront) 17 | #include 18 | #endif 19 | #include 20 | #include 21 | #include 22 | 23 | typedef void (*VPF) (); 24 | 25 | static FILE *_Warnfp = (FILE *)2; 26 | 27 | static void 28 | _DefaultWarnFunc(char *s) 29 | { 30 | fputs(s, _Warnfp); 31 | 32 | /******************************************/ 33 | /* Lexa redefines fflush in stdio.h */ 34 | /* which results in an unresolved symbol */ 35 | #if defined(__edgfe) && defined(fflush) 36 | #undef fflush 37 | #endif 38 | /******************************************/ 39 | 40 | fflush(_Warnfp); 41 | } 42 | 43 | static VPF _WarnFunc = _DefaultWarnFunc; 44 | 45 | #define MAXERRSIZE BUFSIZ 46 | 47 | /* char _ErrBuf[2 * MAXERRSIZE]; not thread safe moved into functions*/ 48 | 49 | #if defined(__sun__) 50 | extern int sys_nerr; 51 | #endif 52 | 53 | /* preprocess the format string */ 54 | static char * 55 | fixit(int errnum, char *s, char r[]) 56 | { 57 | char *z, *p = r, *cp = s, *str, ctimebuf[60]; 58 | static struct timeval tp; 59 | static struct timezone tzp; 60 | 61 | while (cp && *cp != (char) NULL) { 62 | if (p == &r[MAXERRSIZE - 1]) 63 | return ("bark!\n"); 64 | if (*cp == '%') 65 | switch (*(cp + 1)) { 66 | 67 | /* quoted `%' */ 68 | case '%': 69 | *p++ = *cp++; 70 | *p++ = *cp++; 71 | break; 72 | 73 | /* error string a la syslog(3) */ 74 | case 'm': 75 | if (errnum < 1 || errnum > sys_nerr) 76 | str = "unknown error"; 77 | else 78 | #ifdef HAVE_STRERROR 79 | str = strerror(errnum); 80 | #else 81 | str = sys_errlist[errnum]; 82 | #endif 83 | for (z = str; *z != (char) NULL && 84 | p < &r[MAXERRSIZE - 1]; *p++ = *z++); 85 | cp += 2; 86 | break; 87 | 88 | /* timestamp */ 89 | case 't': 90 | if (gettimeofday(&tp, &tzp) < 0) 91 | str = "(time?) "; 92 | else { 93 | #if defined(__SUNPRO_C) 94 | str = ctime_r(&tp.tv_sec,ctimebuf,sizeof(ctimebuf)); 95 | #else 96 | /* For linux ctimebuf must be at least 26 */ 97 | str = ctime_r(&tp.tv_sec,ctimebuf); 98 | #endif 99 | str[19] = '\0'; 100 | } 101 | for (z = str + 4; *z != (char) NULL && 102 | p < &r[MAXERRSIZE - 1]; *p++ = *z++); 103 | cp += 2; 104 | break; 105 | 106 | /* normal for _doprnt */ 107 | default: 108 | *p++ = *cp++; 109 | break; 110 | } 111 | else 112 | *p++ = *cp++; 113 | } 114 | *p = (char) NULL; 115 | return (r); 116 | } 117 | 118 | void 119 | vWarn(char *fmt, va_list ap) 120 | { 121 | char r[MAXERRSIZE]; 122 | char _ErrBuf[2 * MAXERRSIZE]; 123 | if (_WarnFunc != (VPF) NULL) { 124 | int errnum = errno; 125 | fmt = fixit(errnum, fmt,r); 126 | (void) vsprintf(_ErrBuf, fmt, ap); 127 | (_WarnFunc) (_ErrBuf); 128 | } 129 | } 130 | 131 | void 132 | Warn(char *fmt,...) 133 | { 134 | char r[MAXERRSIZE]; 135 | char _ErrBuf[2 * MAXERRSIZE]; 136 | if (_WarnFunc != (VPF) NULL) { 137 | int errnum = errno; 138 | va_list ap; 139 | 140 | fmt = fixit(errnum, fmt,r); 141 | va_start(ap, fmt); 142 | (void) vsprintf(_ErrBuf, fmt, ap); 143 | va_end(ap); 144 | (_WarnFunc) (_ErrBuf); 145 | } 146 | return; 147 | } 148 | 149 | void 150 | Abort(char *fmt,...) 151 | { 152 | char r[MAXERRSIZE]; 153 | char _ErrBuf[2 * MAXERRSIZE]; 154 | int errnum = errno; 155 | va_list ap; 156 | 157 | fmt = fixit(errnum, fmt,r); 158 | va_start(ap, fmt); 159 | (void) vsprintf(_ErrBuf, fmt, ap); 160 | va_end(ap); 161 | if (_WarnFunc != (VPF) NULL) 162 | (_WarnFunc) (_ErrBuf); 163 | else 164 | _DefaultWarnFunc(_ErrBuf); 165 | abort(); 166 | _Exit(1); 167 | } 168 | 169 | void 170 | Panic(char *fmt,...) 171 | { 172 | char r[MAXERRSIZE]; 173 | char _ErrBuf[2 * MAXERRSIZE]; 174 | int errnum = errno; 175 | va_list ap; 176 | 177 | fmt = fixit(errnum, fmt, r); 178 | va_start(ap, fmt); 179 | (void) vsprintf(_ErrBuf, fmt, ap); 180 | va_end(ap); 181 | if (_WarnFunc != (VPF) NULL) 182 | (_WarnFunc) (_ErrBuf); 183 | else 184 | _DefaultWarnFunc(_ErrBuf); 185 | exit(1); 186 | } 187 | 188 | void 189 | Exit(int exitcode, char *fmt,...) 190 | { 191 | char r[MAXERRSIZE]; 192 | char _ErrBuf[2 * MAXERRSIZE]; 193 | int errnum = errno; 194 | va_list ap; 195 | 196 | fmt = fixit(errnum, fmt, r); 197 | va_start(ap, fmt); 198 | (void) vsprintf(_ErrBuf, fmt, ap); 199 | va_end(ap); 200 | if (_WarnFunc != (VPF) NULL) 201 | (_WarnFunc) (_ErrBuf); 202 | else 203 | _DefaultWarnFunc(_ErrBuf); 204 | exit(exitcode); 205 | } 206 | 207 | void 208 | SetWarn(char *file) 209 | { 210 | static char fnc[] = "SetWarn"; 211 | FILE *fp; 212 | 213 | if ((fp = fopen(file, "w")) == (FILE *) NULL) 214 | Warn("%s fopen(%s): %m\n", fnc, file); 215 | else 216 | _Warnfp = fp; 217 | (void) setbuf(fp, (char *) NULL); 218 | return; 219 | } 220 | 221 | void 222 | SetWarnFP(FILE * fp) 223 | { 224 | _Warnfp = fp; 225 | return; 226 | } 227 | 228 | void 229 | SetWarnFunc(VPF f) 230 | { 231 | _WarnFunc = f; 232 | return; 233 | } 234 | -------------------------------------------------------------------------------- /dap/exbo.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_exbo_h 2 | #define included_dap_exbo_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | 13 | /* external struct, union, typedef and enum declarations */ 14 | struct exbo 15 | { 16 | unsigned negative; 17 | unsigned first; 18 | unsigned current; 19 | unsigned last; 20 | }; 21 | 22 | /* external function declarations */ 23 | #if defined(__STDC__) || defined(__cplusplus) || defined(_AIX) 24 | # ifdef __cplusplus 25 | extern "C" { 26 | # endif 27 | extern struct exbo *exboalloc(int,int); 28 | extern int exbobackoff(struct exbo *); 29 | extern void exbofree(struct exbo *); 30 | extern int exboreset(struct exbo *); 31 | extern int exbovalue(struct exbo *); 32 | # ifdef __cplusplus 33 | } 34 | # endif 35 | #else 36 | extern struct exbo *exboalloc(); 37 | extern int exbobackoff(); 38 | extern void exbofree(); 39 | extern int exboreset(); 40 | extern int exbovalue(); 41 | #endif 42 | #endif 43 | 44 | -------------------------------------------------------------------------------- /dap/fds.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_fds_h 2 | #define included_dap_fds_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | 13 | /* header file inclusions */ 14 | #include 15 | #include 16 | 17 | /* external data declarations */ 18 | extern int fds_howmany; 19 | extern int fds_size; 20 | extern int fds_sizeof; 21 | extern fd_set *fds_all; 22 | extern fd_set *fds_none; 23 | extern fd_set *fds_r; 24 | extern fd_set *fds_ra; 25 | extern fd_set *fds_w; 26 | extern fd_set *fds_wa; 27 | extern fd_set *fds_x; 28 | extern fd_set *fds_xa; 29 | 30 | /* external function declarations */ 31 | #if defined(__STDC__) || defined(__cplusplus) || defined(_AIX) || defined(linux) || defined(__CYGWIN__) 32 | # ifdef __cplusplus 33 | extern "C" { 34 | # endif 35 | extern fd_set *fdsalloc( void ); 36 | extern fd_set *fdsalloc_r( void ); 37 | extern int fdsanyset( fd_set * ); 38 | extern void fdsclr( fd_set *, int ); 39 | extern void fdscopy( fd_set *, fd_set * ); 40 | extern fd_set *fdsdup( fd_set * ); 41 | extern fd_set *fdsdup_r( fd_set * ); 42 | extern void fdsfree( fd_set * ); 43 | extern void fdsfresh( int fd ); 44 | extern void fdsinit( void ); 45 | extern int fdsisset( fd_set *, int ); 46 | extern void fdsset( fd_set *, int ); 47 | extern void fdsterm( void ); 48 | extern void fdszero( fd_set * ); 49 | # ifdef __cplusplus 50 | } 51 | # endif 52 | #else 53 | extern fd_set *fdsalloc(); 54 | extern fd_set *fdsalloc_r(); 55 | extern int fdsanyset(); 56 | extern void fdsclr(); 57 | extern void fdscopy(); 58 | extern fd_set *fdsdup(); 59 | extern fd_set *fdsdup_r(); 60 | extern void fdsfree(); 61 | extern void fdsfresh(); 62 | extern void fdsinit(); 63 | extern int fdsisset(); 64 | extern void fdsset(); 65 | extern void fdsterm(); 66 | extern void fdszero(); 67 | #endif 68 | 69 | #endif 70 | 71 | #ifndef __FDS_BITS 72 | #define __FDS_BITS(set) ((set)->fds_bits) 73 | #endif 74 | -------------------------------------------------------------------------------- /dap/fletch.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_fletch_h 2 | #define included_dap_fletch_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | 13 | /* external struct, union, typedef and enum declarations */ 14 | struct fletch 15 | { 16 | int c0; /* current c0 counter value */ 17 | int c1; /* current c1 counter value */ 18 | int modfreq; /* frequency of mod operations */ 19 | int tilmod; /* number of bytes til next mod operation */ 20 | }; 21 | 22 | /* external function declarations */ 23 | #if defined(__STDC__) || defined(__cplusplus) || defined(_AIX) 24 | # ifdef __cplusplus 25 | extern "C" { 26 | # endif 27 | extern struct fletch *fletchalloc(void); 28 | extern void fletchfree(struct fletch *); 29 | extern void fletchsum(struct fletch *,char *,int); 30 | extern int fletchcheck(char *,int,int); 31 | extern void fletchdone(struct fletch *,char *,int,int); 32 | extern void fletchpatch(char *,int,char *,int,int); 33 | # ifdef __cplusplus 34 | } 35 | # endif 36 | #else 37 | extern struct fletch *fletchalloc(); 38 | extern void fletchfree(); 39 | extern void fletchsum(); 40 | extern int fletchcheck(); 41 | extern void fletchdone(); 42 | extern void fletchpatch(); 43 | #endif 44 | 45 | #endif 46 | 47 | -------------------------------------------------------------------------------- /dap/hash.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_hash_h 2 | #define included_dap_hash_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | 13 | /* header file inclusions */ 14 | #include 15 | 16 | /* external macro declarations */ 17 | #define HASH_TBLSZ (5021) /* default hash table size */ 18 | 19 | /* external struct, union, typedef and enum declarations */ 20 | struct hash 21 | { 22 | struct node *tbl; /* hash table */ 23 | int tblsz; /* hash table size */ 24 | int (*hashfunc)(); 25 | void *(*value)(); 26 | struct node *(*find)(); 27 | struct node *(*insert)(); 28 | void (*replace)(); 29 | void (*remove)(); 30 | }; 31 | 32 | /* external function declarations */ 33 | #if defined(__STDC__) || defined(__cplusplus) || defined(_AIX) 34 | # ifdef __cplusplus 35 | extern "C" { 36 | # endif 37 | extern struct hash *hashalloc( 38 | int,int (*)(),void *(*)(), 39 | struct node *(*)(), 40 | struct node *(*)(),void (*)(), 41 | void (*)() 42 | ); 43 | extern void *hashfind(struct hash *,void *); 44 | extern void hashfree(struct hash *); 45 | extern void *hashinsert(struct hash *,void *,void *); 46 | extern struct node *hashnode(struct hash *,void *); 47 | extern void *hashremove(struct hash *,void *); 48 | extern void *hashreplace(struct hash *,void *,void *); 49 | extern void *hashwalk(struct hash *,void*(*)(),void *); 50 | # ifdef __cplusplus 51 | } 52 | # endif 53 | #else 54 | extern struct hash *hashalloc(); 55 | extern void *hashfind(); 56 | extern void hashfree(); 57 | extern void *hashinsert(); 58 | extern struct node *hashnode(); 59 | extern void *hashremove(); 60 | extern void *hashreplace(); 61 | extern void *hashwalk(); 62 | #endif 63 | 64 | #endif 65 | 66 | -------------------------------------------------------------------------------- /dap/hpp.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_hpp_h 2 | #define included_dap_hpp_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | 13 | /* header file inclusions */ 14 | #include 15 | #include 16 | #include 17 | 18 | /* external struct, union, typedef and enum declarations */ 19 | struct hpp 20 | { 21 | char *host; /* hostname */ 22 | unsigned short port; /* port number */ 23 | }; 24 | 25 | /* external function declarations */ 26 | #if defined(__STDC__) || defined(__cplusplus) || defined(_AIX) 27 | # ifdef __cplusplus 28 | extern "C" { 29 | # endif 30 | extern struct hpp *hppalloc(char *, unsigned short); 31 | extern void hppfree(struct hpp *); 32 | extern struct hpp *hppmake_in(struct sockaddr_in *); 33 | extern struct sockaddr_in *hppname_in(struct hpp *,int *); 34 | # ifdef __cplusplus 35 | } 36 | # endif 37 | #else 38 | extern struct hpp *hppalloc(); 39 | extern void hppfree(); 40 | extern struct hpp *hppmake_in(); 41 | extern struct sockaddr_in *hppname_in(); 42 | #endif 43 | 44 | #endif 45 | 46 | -------------------------------------------------------------------------------- /dap/kvp.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_kvp_h 2 | #define included_dap_kvp_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | 13 | /* header file inclusions */ 14 | #include 15 | 16 | /* external macro declarations */ 17 | #define KVPAT(np) ((struct kvp *)((np)->d)) 18 | 19 | /* external struct, union, typedef and enum declarations */ 20 | 21 | /* key value pair */ 22 | struct kvp 23 | { 24 | void *key; 25 | void *d; 26 | }; 27 | 28 | /* external function declarations */ 29 | #if defined(__STDC__) || defined(__cplusplus) || defined(_AIX) 30 | # ifdef __cplusplus 31 | extern "C" { 32 | # endif 33 | extern struct kvp *kvpalloc(void *,void *); 34 | extern struct node *kvpfind(struct node *,char *); 35 | extern void kvpfree(struct kvp *); 36 | extern struct node *kvpinsert(struct node *,void *,void *); 37 | extern void *kvpkey(struct node *); 38 | extern void kvpremove(struct node *); 39 | extern void kvpreplace(struct node *,void *); 40 | extern void *kvpvalue(struct node *); 41 | # ifdef __cplusplus 42 | } 43 | # endif 44 | #else 45 | extern struct kvp *kvpalloc(); 46 | extern struct node *kvpfind(); 47 | extern void kvpfree(); 48 | extern struct node *kvpinsert(); 49 | extern void *kvpkey(); 50 | extern void kvpremove(); 51 | extern void kvpreplace(); 52 | extern void *kvpvalue(); 53 | #endif 54 | 55 | #endif 56 | 57 | -------------------------------------------------------------------------------- /dap/lstn.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_lstn_h 2 | #define included_dap_lstn_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | 13 | /* header file inclusions */ 14 | #include 15 | #include 16 | #include 17 | #ifdef PRESUNOS4 18 | # ifndef _SOCKET_ 19 | # define _SOCKET_ 20 | # include 21 | # endif 22 | #else 23 | # include 24 | #endif 25 | #include 26 | #include 27 | #include 28 | 29 | /* external macro declarations */ 30 | 31 | /* lstn retry values */ 32 | #define LSTN_RETRY_NO (0) 33 | #define LSTN_RETRY_YES (1) 34 | 35 | /* external struct, union, typedef and enum declarations */ 36 | struct lstn 37 | { 38 | /* configuration information */ 39 | char *name; /* listener's name */ 40 | int pri; /* connection accept priority */ 41 | int retry; /* retry listening after failure */ 42 | int domain; /* socket address domain */ 43 | int type; /* socket type */ 44 | int protocol; /* socket protocol */ 45 | int r_namelen; /* maximum remote name len on accept */ 46 | void *l_nameinfo; /* local name information */ 47 | int (*l_namefunc)(); /* l_nameinfo to l_name func */ 48 | int (*l_regfunc)(); /* local name registration function */ 49 | void (*acptfunc)(); /* connection accept function */ 50 | void *acb; /* application's control block */ 51 | 52 | /* state information */ 53 | struct exbo *retry_time; /* retry time limit with back-off */ 54 | struct timer *retry_tp; /* retry timer */ 55 | int fd; /* file descriptor */ 56 | int l_namelen; /* local name length */ 57 | struct sockaddr *l_name; /* local name */ 58 | struct chan *acptchan; /* connection accept channel */ 59 | 60 | /* administrative information */ 61 | time_t alloctod; /* time listener was allocated */ 62 | time_t opentod; /* time listener was opened */ 63 | time_t lstntod; /* time listener started listening */ 64 | time_t acpttod; /* time of last accept */ 65 | time_t deaftod; /* time of listener stopped listening */ 66 | time_t closetod; /* time of last close */ 67 | time_t opendtime; /* seconds opened in prev instances */ 68 | time_t lstndtime; /* seconds listened in prev instnaces */ 69 | unsigned opencount; /* number of times opened */ 70 | unsigned lstncount; /* number of times listening */ 71 | unsigned acptcount; /* number of connections accepted */ 72 | unsigned deafcount; /* number of times stopped listening */ 73 | unsigned closecount; /* number of times closed */ 74 | }; 75 | 76 | /* external function declarations */ 77 | #if defined(__STDC__) || defined(__cplusplus) || defined(_AIX) 78 | # ifdef __cplusplus 79 | extern "C" { 80 | # endif 81 | extern struct lstn *lstnalloc( 82 | char *,int,int,int,int,int,int,int,int, 83 | void *,int (*)(),int (*)(),void (*)(),void * 84 | ); 85 | extern void lstnclose(struct lstn *); 86 | extern void lstnfree(struct lstn *); 87 | extern void lstnopen(struct lstn *); 88 | # ifdef __cplusplus 89 | } 90 | # endif 91 | #else 92 | extern struct lstn *lstnalloc(); 93 | extern void lstnclose(); 94 | extern void lstnfree(); 95 | extern void lstnopen(); 96 | #endif 97 | 98 | #endif 99 | 100 | -------------------------------------------------------------------------------- /dap/misc.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_misc_h 2 | #define included_dap_misc_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | 13 | /* header file inclusions */ 14 | #include 15 | #include 16 | #include 17 | #ifdef PRESUNOS4 18 | # ifndef _SOCKET_ 19 | # define _SOCKET_ 20 | # include 21 | # endif 22 | #else 23 | # include 24 | #endif 25 | #include 26 | #include 27 | #include 28 | 29 | /* external macro declarations */ 30 | #define CHARAT(np) ((char *)((np)->d)) 31 | #define UINTAT(np) ((unsigned)((np)->d)) 32 | 33 | /* round v to r, the lim inf { i : ((i % m) == 0) && (i >= v)} */ 34 | #define MODRNDUP(v, m) (((v) + (m)) - (1 + ((((v) + (m)) - 1) % (m)))) 35 | 36 | /* external data declarations */ 37 | extern int dapbreak; 38 | extern int dapInitialized; 39 | extern int dapZeroTimeout; 40 | extern char hostname_l[]; 41 | extern int parity[]; 42 | 43 | /* external function declarations */ 44 | #if defined(__STDC__) || defined(__cplusplus) || defined(_AIX) 45 | # ifdef __cplusplus 46 | extern "C" { 47 | # endif 48 | extern int BcdPack( char *,int, unsigned char * ); 49 | extern int BcdUnpack( unsigned char *, int, char * ); 50 | extern int PrAscDecode( int, struct buff *,int ); 51 | extern void PrAscEncode( int, struct buff * ); 52 | extern void daploop(void); 53 | extern void dapselect(); 54 | extern void dapterm(); 55 | extern int dapversion(); 56 | extern void doclose(int); 57 | extern int doread(int, char *, int ); 58 | extern int doselect( int, fd_set *, fd_set *, fd_set *, struct timeval * ); 59 | extern int dowrite( int, char *, int ); 60 | extern char *hostname(); 61 | extern int mod255(); 62 | extern void noop(); 63 | extern struct sockaddr_in *servname_in( char *, int * ); 64 | extern int ulbetween(); 65 | # ifdef __cplusplus 66 | } 67 | # endif 68 | #else 69 | extern int BcdPack(); 70 | extern int BcdUnpack(); 71 | extern int PrAscDecode(); 72 | extern void PrAscEncode(); 73 | extern void daploop(); 74 | extern void dapselect(); 75 | extern void dapterm(); 76 | extern int dapversion(); 77 | extern void doclose(); 78 | extern int doread(); 79 | extern int doselect(); 80 | extern int dowrite(); 81 | extern char *hostname(); 82 | extern int mod255(); 83 | extern void noop(); 84 | extern struct sockaddr_in *servname_in(); 85 | extern int ulbetween(); 86 | #endif 87 | 88 | #endif 89 | 90 | -------------------------------------------------------------------------------- /dap/mtm.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_mtm_h 2 | #define included_dap_mtm_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | 13 | /* many to many relationships */ 14 | 15 | /* header file inclusions */ 16 | #include 17 | 18 | /* external macro declarations */ 19 | #define MTMAT(np) ((struct mtm *)((np)->d)) 20 | 21 | /* external struct, union, typedef and enum declarations */ 22 | struct mtm 23 | { 24 | struct node *unp; 25 | void *up; 26 | struct node *dnp; 27 | void *dp; 28 | void *d; 29 | }; 30 | 31 | /* external function declarations */ 32 | #if defined(__STDC__) || defined(__cplusplus) || defined(_AIX) 33 | # ifdef __cplusplus 34 | extern "C" { 35 | # endif 36 | extern struct mtm *mtmalloc(void *); 37 | extern void mtmdnins(struct mtm *,struct node *,void *); 38 | extern void mtmdnrm(struct mtm *); 39 | extern void mtmfree(struct mtm *); 40 | extern struct mtm *mtmlink(struct node *,void *,struct node *, 41 | void *,void *); 42 | extern void mtmunlink(struct mtm *); 43 | extern void mtmupins(struct mtm *,struct node *,void *); 44 | extern void mtmuprm(struct mtm *); 45 | extern void *mtmvalue(struct node *); 46 | # ifdef __cplusplus 47 | } 48 | # endif 49 | #else 50 | extern struct mtm *mtmalloc(); 51 | extern void mtmdnins(); 52 | extern void mtmdnrm(); 53 | extern void mtmfree(); 54 | extern struct mtm *mtmlink(); 55 | extern void mtmunlink(); 56 | extern void mtmupins(); 57 | extern void mtmuprm(); 58 | extern void *mtmvalue(); 59 | #endif 60 | 61 | #endif 62 | 63 | -------------------------------------------------------------------------------- /dap/node.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_node_h 2 | #define included_dap_node_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | 13 | /* external macro declarations */ 14 | #define NODEAT(np) ((struct node *)((np)->d)) 15 | 16 | /* external struct, union, typedef and enum declarations */ 17 | struct node 18 | { 19 | struct node *f; 20 | struct node *b; 21 | void *d; 22 | }; 23 | 24 | /* external function declarations */ 25 | #if defined(__STDC__) || defined(__cplusplus) || defined(_AIX) 26 | # ifdef __cplusplus 27 | extern "C" { 28 | # endif 29 | extern struct node *nodealloc(void); 30 | extern struct node *nodealloc_r(void); 31 | extern void nodefree(struct node *); 32 | extern void nodeinsert(struct node *,struct node *); 33 | extern void noderemove(struct node *); 34 | extern void nodesort(struct node *,int (*)()); 35 | extern void nodetoad(struct node *); 36 | # ifdef __cplusplus 37 | } 38 | # endif 39 | #else 40 | extern struct node *nodealloc(); 41 | extern struct node *nodealloc_r(); 42 | extern void nodefree(); 43 | extern void nodeinsert(); 44 | extern void noderemove(); 45 | extern void nodesort(); 46 | extern void nodetoad(); 47 | #endif 48 | 49 | #endif 50 | 51 | -------------------------------------------------------------------------------- /dap/notsunos4.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_notsunos4_h 2 | #define included_dap_notsunos4_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | 13 | /* header file inclusions */ 14 | 15 | #ifndef FD_SET 16 | # ifdef _AIX 17 | # include 18 | # else 19 | 20 | /* external macro declarations */ 21 | # define PRESUNOS4 /* Pre-SunOS 4.0 */ 22 | 23 | /* The following is taken from on SunOS 4.0. 24 | * It is necessary because fd_set's are not used. 25 | */ 26 | # define NBBY 8 /* number of bits in a byte */ 27 | /* 28 | * Select uses bit masks of file descriptors in longs. 29 | * These macros manipulate such bit fields (the filesystem 30 | * macros use chars). FD_SETSIZE may be defined by the user, 31 | * but the default here should be >= NOFILE (param.h). 32 | */ 33 | # ifndef FD_SETSIZE 34 | /* this coincides with SUNOS 3.5 definition of fd_set */ 35 | # define FD_SETSIZE (sizeof(int) * NBBY) 36 | # endif 37 | 38 | # define NFDBITS (sizeof(fd_mask) * NBBY) /* bits per mask */ 39 | # ifndef howmany 40 | # ifdef sun386 41 | # define howmany(x, y) \ 42 | ((((unsigned int)(x))+(((unsigned int)(y))-1))/((unsigned int)(y))) 43 | # else 44 | # define howmany(x, y) (((x)+((y)-1))/(y)) 45 | # endif 46 | # endif 47 | 48 | # define FD_SET(n, p) \ 49 | ((p)->fds_bits[(n)/NFDBITS] |= (1 << ((n) % NFDBITS))) 50 | # define FD_CLR(n, p) \ 51 | ((p)->fds_bits[(n)/NFDBITS] &= ~(1 << ((n) % NFDBITS))) 52 | # define FD_ISSET(n, p) \ 53 | ((p)->fds_bits[(n)/NFDBITS] & (1 << ((n) % NFDBITS))) 54 | # define FD_ZERO(p) bzero((char *)(p), sizeof(*(p))) 55 | 56 | /* external struct, union, typedef and enum declarations */ 57 | /* this coincides with SUNOS 3.5 usage, SUNOS 4.0 uses long */ 58 | typedef int fd_mask; 59 | # endif 60 | 61 | #endif 62 | 63 | #endif 64 | 65 | -------------------------------------------------------------------------------- /dap/sgnl.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_sgnl_h 2 | #define included_dap_sgnl_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | 13 | /* header file inclusions */ 14 | #include 15 | #ifndef NSIG 16 | #define NSIG _sys_nsig 17 | #endif 18 | 19 | 20 | /* external struct, union, typedef and enum declarations */ 21 | struct sgnl 22 | { 23 | int set; 24 | //#if defined(HAVE_SIGACTION) 25 | struct sigaction orig; 26 | //#else 27 | // struct sigvec orig; 28 | //#endif 29 | int flag; 30 | void (*func)(); 31 | }; 32 | 33 | /* external data declarations */ 34 | extern struct sgnl sgnls[]; 35 | 36 | /* external function declarations */ 37 | #if defined(__STDC__) || defined(__cplusplus) || defined(_AIX) 38 | # ifdef __cplusplus 39 | extern "C" { 40 | # endif 41 | extern void sgnlcatch(int,void (*)()); 42 | extern void sgnldefault(int); 43 | extern void sgnlignore(int); 44 | extern void sgnloriginal(int); 45 | extern int sgnlproc(void); 46 | # ifdef __cplusplus 47 | } 48 | # endif 49 | #else 50 | extern void sgnlcatch(); 51 | extern void sgnldefault(); 52 | extern void sgnlignore(); 53 | extern void sgnloriginal(); 54 | extern int sgnlproc(); 55 | #endif 56 | 57 | #endif 58 | 59 | -------------------------------------------------------------------------------- /dap/slpq.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_slpq_h 2 | #define included_dap_slpq_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | 13 | /* header file inclusions */ 14 | #include 15 | 16 | /* external macro declarations */ 17 | #define SLPQENTAT(np) ((struct slpqent *)((np)->d)) 18 | 19 | /* external struct, union, typedef and enum declarations */ 20 | 21 | /* structure for saving sleep queue state information */ 22 | struct slpq 23 | { 24 | struct node *wq; /* queue of waiting callbacks */ 25 | int wakes; /* number unmatched signals */ 26 | int maxwakes; /* maximum unmatched signals allowed */ 27 | }; 28 | 29 | /* structure for saving callback information */ 30 | struct slpqent 31 | { 32 | struct node *np; /* queueing node */ 33 | struct slpq *sp; /* pointer to sleep queue */ 34 | void (*func)(); /* callback function */ 35 | void *arg; /* callback function argument */ 36 | int sched; /* whether it is already scheduled */ 37 | }; 38 | 39 | /* external data declarations */ 40 | extern struct node slpqents; 41 | 42 | /* external function declarations */ 43 | #if defined(__STDC__) || defined(__cplusplus) || defined(_AIX) 44 | # ifdef __cplusplus 45 | extern "C" { 46 | # endif 47 | extern struct slpq *slpqalloc(int,int); 48 | extern void slpqfree( struct slpq *); 49 | extern void slpqgiveup(struct slpqent *); 50 | extern void slpqimmed(void (*)(),void *); 51 | extern int slpqproc(void); 52 | extern void slpqsched(struct slpqent *,void (*)()); 53 | extern struct slpqent *slpqsleep(struct slpq *,void (*)(), 54 | void *,void (*)() ); 55 | extern void slpqwakeup( struct slpq *,void (*)()); 56 | # ifdef __cplusplus 57 | } 58 | # endif 59 | #else 60 | extern struct slpq *slpqalloc(); 61 | extern void slpqfree(); 62 | extern void slpqgiveup(); 63 | extern void slpqimmed(); 64 | extern int slpqproc(); 65 | extern void slpqsched(); 66 | extern struct slpqent *slpqsleep(); 67 | extern void slpqwakeup(); 68 | #endif 69 | #endif 70 | 71 | 72 | 73 | -------------------------------------------------------------------------------- /dap/timer.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_timer_h 2 | #define included_dap_timer_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | 13 | /* header file inclusions */ 14 | #include 15 | #include 16 | #include 17 | #include 18 | 19 | /* external macro declarations */ 20 | #define TIMERAT(np) ((struct timer *)((np)->d)) 21 | 22 | /* external struct, union, typedef and enum declarations */ 23 | struct timer 24 | { 25 | struct node *np; 26 | struct timeval expire; 27 | void (*func)(); 28 | void *arg; 29 | }; 30 | 31 | /* external data declarations */ 32 | extern struct node timers; 33 | 34 | /* external function declarations */ 35 | #if defined(__STDC__) || defined(__cplusplus) || defined(_AIX) 36 | # ifdef __cplusplus 37 | extern "C" { 38 | # endif 39 | extern struct timer *timer(time_t,long,void (*)(void *),void *); 40 | extern struct timer *timerabs(time_t,long,void (*)(),void *); 41 | extern void timerclr(struct timer *); 42 | extern struct timeval *timernext(void); 43 | extern int timerproc(void); 44 | # ifdef __cplusplus 45 | } 46 | # endif 47 | #else 48 | extern struct timer *timer(); 49 | extern struct timer *timerabs(); 50 | extern void timerclr(); 51 | extern struct timeval *timernext(); 52 | extern int timerproc(); 53 | #endif 54 | #endif 55 | 56 | -------------------------------------------------------------------------------- /dap/tr.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_tr_h 2 | #define included_dap_tr_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | 13 | /* external macro declarations */ 14 | #define TRCHAR(tr, c) ((int)((tr)[(unsigned)((c)&0xff))) 15 | 16 | /* external data declarations */ 17 | extern unsigned char tr_atoe[]; 18 | extern unsigned char tr_etoa[]; 19 | extern unsigned char tr_quadav[]; 20 | 21 | /* external function declarations */ 22 | #if defined(__STDC__) || defined(__cplusplus) || defined(_AIX) 23 | # ifdef __cplusplus 24 | extern "C" { 25 | # endif 26 | extern int trchar(unsigned char *, char); /* translate char using table */ 27 | # ifdef __cplusplus 28 | } 29 | # endif 30 | #else 31 | extern int trchar(); /* translate char using table */ 32 | #endif 33 | #endif 34 | 35 | -------------------------------------------------------------------------------- /dap/tv.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_tv_h 2 | #define included_dap_tv_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | 13 | /* header file inclusions */ 14 | #include 15 | 16 | /* external macro declarations */ 17 | #define MILLION_USECS ((long)(1000000)) 18 | 19 | /* external function declarations */ 20 | #if defined(__STDC__) || defined(__cplusplus) || defined(_AIX) 21 | # ifdef __cplusplus 22 | extern "C" { 23 | # endif 24 | extern int tvdiff(struct timeval *,struct timeval *,struct timeval *); 25 | extern int tvnorm(struct timeval *); 26 | extern char *tvstring(struct timeval *); 27 | extern int tvsum(struct timeval *,struct timeval *,struct timeval *); 28 | # ifdef __cplusplus 29 | } 30 | # endif 31 | #else 32 | extern int tvdiff(); 33 | extern int tvnorm(); 34 | extern char *tvstring(); 35 | extern int tvsum(); 36 | #endif 37 | #endif 38 | 39 | -------------------------------------------------------------------------------- /dap/ulto.h: -------------------------------------------------------------------------------- 1 | #ifndef included_dap_ulto_h 2 | #define included_dap_ulto_h 3 | 4 | /*****************************************************************************/ 5 | /* */ 6 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 7 | /* See .../src/LICENSE for terms of distribution. */ 8 | /* */ 9 | /* */ 10 | /*****************************************************************************/ 11 | 12 | 13 | /* external macro declarations */ 14 | #define ULTOHEX_SZ 9 /* longest hex string for unsigned long */ 15 | #define ULTODEC_SZ 11 /* longest decimal string for unsigned long */ 16 | #define ULTOOCT_SZ 12 /* longest octal string for unsigned long */ 17 | 18 | /* external function declarations */ 19 | #if defined(__STDC__) || defined(__cplusplus) || defined(_AIX) 20 | # ifdef __cplusplus 21 | extern "C" { 22 | # endif 23 | extern int ultodec(unsigned long,char *,int); 24 | extern int ultohex(unsigned long,char *,int); 25 | extern int ultooct(unsigned long,char *,int); 26 | # ifdef __cplusplus 27 | } 28 | # endif 29 | #else 30 | extern int ultodec(); 31 | extern int ultohex(); 32 | extern int ultooct(); 33 | #endif 34 | 35 | #endif 36 | 37 | -------------------------------------------------------------------------------- /dap/ultodec.c: -------------------------------------------------------------------------------- 1 | /*****************************************************************************/ 2 | /* */ 3 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 4 | /* See .../src/LICENSE for terms of distribution. */ 5 | /* */ 6 | /* */ 7 | /*****************************************************************************/ 8 | /* contributed by Daniel F. Fisher */ 9 | 10 | /* convert unsigned long integer to decimal character string */ 11 | 12 | /* head file inclusions */ 13 | #include 14 | 15 | /* internal data definitions */ 16 | static unsigned long powers[ULTODEC_SZ] = 17 | { 18 | 0L, /* zero */ 19 | 9L, 99L, 999L, /* units, tens, hundreds */ 20 | 9999L, 99999L, 999999L, /* thousands */ 21 | 9999999L, 99999999L, 999999999L, /* millions */ 22 | 0xffffffffL /* sentinel */ 23 | }; 24 | 25 | static char digits[10] = 26 | { 27 | '0', '1', '2', '3', '4', '5', '6', '7', '8', '9' 28 | }; 29 | 30 | /* external function definitions */ 31 | int 32 | ultodec(long unsigned int value, char *result, int length) 33 | { 34 | int place; 35 | 36 | /* determine number of places to be used */ 37 | if (value == 0) { 38 | place = 1; 39 | } else { 40 | for (place = 1; value > powers[place]; place++); 41 | } 42 | if (place < length) { 43 | int rc = place + 1; /* return code */ 44 | 45 | while (place-- > 0) { 46 | unsigned long p = powers[place] + 1; 47 | int v; 48 | 49 | for (v = 0; value >= p; value -= p, v++); 50 | *result++ = digits[v]; 51 | } 52 | *result = '\0'; 53 | 54 | return rc; 55 | } else { 56 | /* insufficent space in caller provided string */ 57 | return -1; 58 | } 59 | 60 | /* NOTREACHED */ 61 | } 62 | 63 | /* internal function definitions */ 64 | 65 | #ifdef UNITTEST 66 | /* unit test header file inclusions */ 67 | #include 68 | 69 | /* unit test function declarations */ 70 | extern int main(); 71 | extern void unittest(); 72 | 73 | /* unit test function definitions */ 74 | int 75 | main(argc, argv) 76 | int argc; 77 | char *argv[]; 78 | { 79 | int length; 80 | int count; 81 | int printit; 82 | 83 | if (argc < 2) { 84 | length = ULTODEC_SZ; 85 | } else { 86 | length = atoi(argv[1]); 87 | } 88 | if (argc < 3) { 89 | count = 1; 90 | printit = 1; 91 | } else { 92 | count = atoi(argv[2]); 93 | printit = 0; 94 | } 95 | 96 | while (count-- > 0) { 97 | unittest((unsigned long) (0), length, printit); 98 | unittest((unsigned long) (1), length, printit); 99 | unittest((unsigned long) (2), length, printit); 100 | unittest((unsigned long) (3), length, printit); 101 | unittest((unsigned long) (4), length, printit); 102 | unittest((unsigned long) (5), length, printit); 103 | unittest((unsigned long) (6), length, printit); 104 | unittest((unsigned long) (7), length, printit); 105 | unittest((unsigned long) (8), length, printit); 106 | unittest((unsigned long) (9), length, printit); 107 | unittest((unsigned long) (10), length, printit); 108 | unittest((unsigned long) (19), length, printit); 109 | unittest((unsigned long) (28), length, printit); 110 | unittest((unsigned long) (37), length, printit); 111 | unittest((unsigned long) (46), length, printit); 112 | unittest((unsigned long) (55), length, printit); 113 | unittest((unsigned long) (64), length, printit); 114 | unittest((unsigned long) (73), length, printit); 115 | unittest((unsigned long) (82), length, printit); 116 | unittest((unsigned long) (91), length, printit); 117 | unittest((unsigned long) (99), length, printit); 118 | unittest((unsigned long) (100), length, printit); 119 | unittest((unsigned long) (109), length, printit); 120 | unittest((unsigned long) (280), length, printit); 121 | unittest((unsigned long) (372), length, printit); 122 | unittest((unsigned long) (406), length, printit); 123 | unittest((unsigned long) (525), length, printit); 124 | unittest((unsigned long) (640), length, printit); 125 | unittest((unsigned long) (731), length, printit); 126 | unittest((unsigned long) (802), length, printit); 127 | unittest((unsigned long) (911), length, printit); 128 | unittest((unsigned long) (999), length, printit); 129 | unittest((unsigned long) (1000), length, printit); 130 | unittest((unsigned long) (9999), length, printit); 131 | unittest((unsigned long) (10000), length, printit); 132 | unittest((unsigned long) (99999), length, printit); 133 | unittest((unsigned long) (100000), length, printit); 134 | unittest((unsigned long) (999999), length, printit); 135 | unittest((unsigned long) (1000000), length, printit); 136 | unittest((unsigned long) (9999999), length, printit); 137 | unittest((unsigned long) (10000000), length, printit); 138 | unittest((unsigned long) (99999999), length, printit); 139 | unittest((unsigned long) (100000000), length, printit); 140 | unittest((unsigned long) (999999999), length, printit); 141 | unittest((unsigned long) (1000000000), length, printit); 142 | unittest((unsigned long) (2000000000), length, printit); 143 | unittest((unsigned long) (3000000000), length, printit); 144 | unittest((unsigned long) (4000000000), length, printit); 145 | } 146 | exit(0); 147 | /* NOTREACHED */ 148 | } 149 | 150 | static void 151 | unittest(value, length, printit) 152 | unsigned long value; 153 | int length; 154 | int printit; 155 | { 156 | int rc; 157 | static char result[ULTODEC_SZ]; 158 | 159 | result[0] = '\0'; 160 | rc = ultodec(value, result, length); 161 | if (printit) { 162 | (void) fprintf(stdout, 163 | "ultodec(%lu, %s, %d) = %d\n", 164 | value, result, length, rc); 165 | 166 | /* Lexa redefines fflush in stdio.h */ 167 | /* which results in an unresolved symbol */ 168 | #if defined(__edgfe) && defined(fflush) 169 | #undef fflush 170 | #endif 171 | /******************************************/ 172 | 173 | fflush(stdout); 174 | } 175 | return; 176 | } 177 | #endif 178 | -------------------------------------------------------------------------------- /dap/ultohex.c: -------------------------------------------------------------------------------- 1 | /*****************************************************************************/ 2 | /* */ 3 | /* Copyright (c) 1989-2008 Morgan Stanley All rights reserved.*/ 4 | /* See .../src/LICENSE for terms of distribution. */ 5 | /* */ 6 | /* */ 7 | /*****************************************************************************/ 8 | /* contributed by Daniel F. Fisher */ 9 | 10 | /* convert unsigned long integer to decimal character string */ 11 | 12 | /* head file inclusions */ 13 | #include 14 | 15 | /* internal data definitions */ 16 | static unsigned long powers[ULTOHEX_SZ] = 17 | { 18 | 0x0L, 19 | 0xfL, 0xffL, 0xfffL, 0xffffL, 20 | 0xfffffL, 0xffffffL, 0xfffffffL, 0xffffffffL 21 | }; 22 | 23 | static char digits[16] = 24 | { 25 | '0', '1', '2', '3', '4', '5', '6', '7', 26 | '8', '9', 'a', 'b', 'c', 'd', 'e', 'f' 27 | }; 28 | 29 | /* external function definitions */ 30 | int 31 | ultohex(long unsigned int value, char *result, int length) 32 | { 33 | int place; 34 | 35 | /* determine number of places to be used */ 36 | if (value == 0) { 37 | place = 1; 38 | } else { 39 | for (place = 1; value > powers[place]; place++); 40 | } 41 | if (place < length) { 42 | int rc = place + 1; /* return code */ 43 | 44 | result[place] = '\0'; 45 | while (place-- > 0) { 46 | result[place] = digits[value % 16]; 47 | value /= 16; 48 | } 49 | 50 | return rc; 51 | } else { 52 | /* insufficent space in caller provided string */ 53 | return -1; 54 | } 55 | 56 | /* NOTREACHED */ 57 | } 58 | 59 | /* internal function definitions */ 60 | 61 | #ifdef UNITTEST 62 | /* unit test header file inclusions */ 63 | #include 64 | 65 | /* unit test function declarations */ 66 | extern int main(); 67 | extern void unittest(); 68 | 69 | /* unit test function definitions */ 70 | int 71 | main(argc, argv) 72 | int argc; 73 | char *argv[]; 74 | { 75 | int length; 76 | int count; 77 | int printit; 78 | 79 | if (argc < 2) { 80 | length = ULTOHEX_SZ; 81 | } else { 82 | length = atoi(argv[1]); 83 | } 84 | if (argc < 3) { 85 | count = 1; 86 | printit = 1; 87 | } else { 88 | count = atoi(argv[2]); 89 | printit = 0; 90 | } 91 | 92 | while (count-- > 0) { 93 | unittest((unsigned long) (0x0), length, printit); 94 | unittest((unsigned long) (0x1), length, printit); 95 | unittest((unsigned long) (0x2), length, printit); 96 | unittest((unsigned long) (0x3), length, printit); 97 | unittest((unsigned long) (0x4), length, printit); 98 | unittest((unsigned long) (0x5), length, printit); 99 | unittest((unsigned long) (0x6), length, printit); 100 | unittest((unsigned long) (0x7), length, printit); 101 | unittest((unsigned long) (0x8), length, printit); 102 | unittest((unsigned long) (0x9), length, printit); 103 | unittest((unsigned long) (0xa), length, printit); 104 | unittest((unsigned long) (0xb), length, printit); 105 | unittest((unsigned long) (0xc), length, printit); 106 | unittest((unsigned long) (0xd), length, printit); 107 | unittest((unsigned long) (0xe), length, printit); 108 | unittest((unsigned long) (0xf), length, printit); 109 | unittest((unsigned long) (0x10), length, printit); 110 | unittest((unsigned long) (0x1f), length, printit); 111 | unittest((unsigned long) (0x2e), length, printit); 112 | unittest((unsigned long) (0x3d), length, printit); 113 | unittest((unsigned long) (0x4c), length, printit); 114 | unittest((unsigned long) (0x5b), length, printit); 115 | unittest((unsigned long) (0x6a), length, printit); 116 | unittest((unsigned long) (0x79), length, printit); 117 | unittest((unsigned long) (0x88), length, printit); 118 | unittest((unsigned long) (0x97), length, printit); 119 | unittest((unsigned long) (0xa6), length, printit); 120 | unittest((unsigned long) (0xb5), length, printit); 121 | unittest((unsigned long) (0xc4), length, printit); 122 | unittest((unsigned long) (0xd3), length, printit); 123 | unittest((unsigned long) (0xe2), length, printit); 124 | unittest((unsigned long) (0xf1), length, printit); 125 | unittest((unsigned long) (0xff), length, printit); 126 | unittest((unsigned long) (0x100), length, printit); 127 | unittest((unsigned long) (0xfff), length, printit); 128 | unittest((unsigned long) (0x1000), length, printit); 129 | unittest((unsigned long) (0xffff), length, printit); 130 | unittest((unsigned long) (0x10000), length, printit); 131 | unittest((unsigned long) (0xfffff), length, printit); 132 | unittest((unsigned long) (0x100000), length, printit); 133 | unittest((unsigned long) (0xffffff), length, printit); 134 | unittest((unsigned long) (0x1000000), length, printit); 135 | unittest((unsigned long) (0xfffffff), length, printit); 136 | unittest((unsigned long) (0x10000000), length, printit); 137 | unittest((unsigned long) (0xffffffff), length, printit); 138 | } 139 | exit(0); 140 | /* NOTREACHED */ 141 | } 142 | 143 | static void 144 | unittest(value, length, printit) 145 | unsigned long value; 146 | int length; 147 | int printit; 148 | { 149 | int rc; 150 | static char result[ULTOHEX_SZ]; 151 | 152 | result[0] = '\0'; 153 | rc = ultohex(value, result, length); 154 | if (printit) { 155 | (void) fprintf(stdout, 156 | "ultohex(%lx, %s, %d) = %d\n", 157 | value, result, length, rc); 158 | 159 | /* Lexa redefines fflush in stdio.h */ 160 | /* which results in an unresolved symbol */ 161 | #if defined(__edgfe) && defined(fflush) 162 | #undef fflush 163 | #endif 164 | /******************************************/ 165 | 166 | fflush(stdout); 167 | } 168 | return; 169 | } 170 | #endif 171 | --------------------------------------------------------------------------------